Scroll en DBGrid
 

Hola a todos:
Trabajo con Delphi5
Necesito hacer lo siguiente y no se si se puede:
Tengo un DBGrid que en pantalla NO saca (por espacio) todos los campos de una tabla. Entonces busco que cuando el ratón llegue a la última/primera columna del DBGrid haga un scroll horizontal automático hacia la derecha o la izquierda sacando el resto de las columnas de la tabla.
Gracias por vuestra ayuda.

Hola, recuerda poner tus preguntas en los foros adecuados, este es "Conexión con bases de datos", y la pregunta no tiene mucho que ver con eso ;)


P.d.: Lo muevo a 'varios'

deberías explicarte mejor porque no entiendo que es lo que quieres hacer !!! ;)

Hola.

A ver si así hace mas o menos lo que buscas... :rolleyes:

Código Delphi [-]
   ...
   private
     procedure MMouseEvent(var Msg: TMsg; var Handled: Boolean);
   end;
...
implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MMouseEvent;
end;

procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
var
  P: TPoint;
begin
  P:= ScreenToClient(Mouse.CursorPos);
  if PtInRect(DBGrid1.BoundsRect,P) then
  begin
    if P.X = DBGrid1.Left + GetSystemMetrics(SM_CXVSCROLL) then
      SendMessage(DBGrid1.Handle, WM_HSCROLL, SB_LINELEFT, 0);
    if P.X = DBGrid1.Left+DBGrid1.Width - GetSystemMetrics(SM_CXVSCROLL) then
      SendMessage(DBGrid1.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
  end;
end;
...

Saludos.

Hola.

Me quede pensando que agregando un detalle te puede servir para más de un TDBGrid en el mismo form:

Código Delphi [-]
  private
     procedure MMouseEvent(var Msg: TMsg; var Handled: Boolean);
  end;

....

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MMouseEvent;
end;

procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
var
  P: TPoint;
  WControl: TWinControl;
  G: TDBGrid;
  i: Integer;
begin
  WControl:= FindVCLWindow(Mouse.CursorPos);
  if Assigned(WControl) and (WControl is TDBGrid) then
  begin
    G:= TDBGRid(WControl);
    P:= ScreenToClient(Mouse.CursorPos);
    if P.X = G.Left + GetSystemMetrics(SM_CXVSCROLL) then
      for i:= G.Columns.Count-1 downto G.SelectedIndex do
        SendMessage(G.Handle, WM_HSCROLL, SB_LINELEFT, 0);
    if P.X = G.Left + G.Width - GetSystemMetrics(SM_CXVSCROLL) then
      for i:= G.SelectedIndex to G.Columns.Count-1 do
        SendMessage(G.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
  end
end;

Saludos.

Ecfisa, muchas gracias por responder
Es "casi" perfecto, lo que pasa es que por ejemplo si una tabla tiene 15 campos y el DBGrid sólo visualiza 5, al llegar a las barras de scroll verticales se mueve automáticamente hasta el último campo de la tabla (sin visualizar los intermedios). Lo ideal sería que cuando el cursor se posicionara sobre la primera/última columna visible (sin llegar a las del scroll vertical-derecha o fijas-izquierda), se moviese una columna mas a la izquierda o derecha.
Eso si que sería perfecto.
Muchas gracias y perdón por el abuso.

Hola marcial.

Entonces creo que el primer código que adjunté se hacercaba más a lo que buscabas.

El problema que veo es que comparando la coordenada X del mouse por la igualdad, te desplazará una columna cuando ingresa a la zona de desplazamiento pero también cuando sale. Esto se soluciona comparando por mayor y menor, pero cualquier movimiento que haga con el mouse una vez en el area de desplazamiento, por pequeño que sea, provocará el scroll. En resumidas cuentas: Es imposible de manejar para el usuario.
Así que la solución es detectar si el puntero del mouse está dentro de las zonas de desplazamiento o nó. Si ya se encuentra dentro no debe realizar el scroll.

Creo que el código que buscas sería:

Código Delphi [-]
procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
{$J+} 
const InZD: Boolean = False; 
{$J-}
var
  P: TPoint;
  WControl: TWinControl;
  G: TDBGrid;
  ZD: Integer;
begin
  WControl:= FindVCLWindow(Mouse.CursorPos);  // ¿ Esta sobre un TWinControl ?
  if Assigned(WControl) and (WControl is TDBGrid) then // ¿ Es tambien un TDBGrid ? 
  begin
    P:= ScreenToClient(Mouse.CursorPos);  // Obtener posición del mouse
    G:= TDBGRid(WControl);                     
    ZD:=  GetSystemMetrics(SM_CXVSCROLL);  // Ancho zona desplazamiento 
    if (P.X < G.Left + ZD) and not InZD then  // Ingresa zona desplazamiento izquierda    
      SendMessage(G.Handle, WM_HSCROLL, SB_LINELEFT, 0);
    if (P.X > G.Left + G.Width - ZD) and not InZD then  // Ingresa zona desplazamiento derecha
      SendMessage(G.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
    InZD:= (P.X < G.Left + ZD) or (P.X > G.Left + G.Width - ZD); // ¿ En zona desplazamiento ?
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MMouseEvent;
end;

De este modo el usuario tiene que volver a la zona de no desplazamiento y reingresar a la de desplazamiento para que se produzca el scroll (izquierdo o derecho).

Saludos.

Solucionado. Muy bien explicado. Da gusto encontrar profesores así.
Muchas Gracias

De hecho, y gracias a tu inestimable ayuda he mezclado tus códigos y he añadido algo hasta que ha quedado a mi gusto.
Reitero nuevamente mi agradecimiento porque sólo no podría haberlo hecho.

Código Delphi [-]
procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
{$J+}
const InZD: Boolean = False;
{$J-}
var
  P, PP: TPoint;
  WControl: TWinControl;
  G: TDBGrid;
  ZD, i: Integer;
begin
  WControl:= FindVCLWindow(Mouse.CursorPos);  // ¿ Esta sobre un TWinControl ?
  if Assigned(WControl) and (WControl is TDBGrid) then // ¿ Es tambien un TDBGrid ?
  begin
    P:= ScreenToClient(Mouse.CursorPos);  // Obtener posición del mouse
    G:= TDBGRid(WControl);
    ZD:=  GetSystemMetrics(SM_CXVSCROLL);  // Ancho zona desplazamiento
    if (P.X < G.Left + ZD) and not InZD then  // Ingresa zona desplazamiento izquierda
         for i:= G.Columns.Count-1 downto G.SelectedIndex do
                begin
                PP := ScreenToClient(Mouse.CursorPos);
                if pp.x <> p.x then exit;
                SendMessage(G.Handle, WM_HSCROLL, SB_LINELEFT, 0);
                sleep(100);
                end;
    if (P.X > G.Left + G.Width - ZD) and not InZD then  // Ingresa zona desplazamiento derecha
      for i:= G.SelectedIndex to G.Columns.Count-1 do  //Así no hay que ingresar en la zona de desplazamiento columna a columna
                begin
                PP := ScreenToClient(Mouse.CursorPos); 
                if pp.x <> p.x then exit;  //Chequea que la posición haya cambiado con respecto de la inicial para salir del buche

                SendMessage(G.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
                sleep(100);  // Una pequeña pausa a gusto del consumidor para que el scroll no sea tan rápido
                end;
    InZD:= (P.X < G.Left + ZD) or (P.X > G.Left + G.Width - ZD); // ¿ En zona desplazamiento ?

  end;
end;

Hola marcial.

Primero que nada, me alegro que el código te haya servido como base :).

Ahora que veo que deseas un scroll continuo con retraso de tiempo, te pongo otra alternativa más simple:

Código Delphi [-]
procedure TForm1.MMouseEvent(var Msg: TMsg; var Handled: Boolean);
var
  P: TPoint;
  WControl: TWinControl;
  G: TDBGrid;
  ZD: Integer;
begin
  WControl:= FindVCLWindow(Mouse.CursorPos);
  if Assigned(WControl) and (WControl is TDBGrid) then
  begin
    P:= ScreenToClient(Mouse.CursorPos);
    G:= TDBGRid(WControl);
    ZD:=  GetSystemMetrics(SM_CXVSCROLL);
    while (P.X >= G.Left) and (P.X <= G.Left+ZD) do
    begin
      P:= ScreenToClient(Mouse.CursorPos);
      SendMessage(G.Handle, WM_HSCROLL, SB_LINELEFT, 0);
      Sleep(250);
    end;
    while (P.X >= G.Left+G.Width-ZD) and (P.X <= G.Left+G.Width) do
    begin
      P:= ScreenToClient(Mouse.CursorPos);
      SendMessage(G.Handle, WM_HSCROLL, SB_LINERIGHT, 0);
      Sleep(250);
    end;
  end;
end;

Saludos.

Muchas gracias. Como siempre, mejor que el mio.

Hola.

Yo no diría mejor... sólo un modo diferente que dá un código más simple.

Saludos.:)

Saludos ecfisa, podría traducir este código a c usted o alguien mas? Seria magnífico !!!

Hola impadrón.


Saludos. :)

PD: No me trates de usted. (la próxima vez que lo hagas te traduzco a Visual Basic :p:D )

Hola de nuevo:
Parece que la felicidad nunca es completa.
Resulta que aplico el código y va perfectamente pero....cuando en el programa existe un componente Application Event para controlar la rueda del ratón con este código en el evento On Message:

Código Delphi [-]
 if Msg.message = WM_MOUSEWHEEL then
   begin
     Msg.message := WM_KEYDOWN;
     Msg.lParam := 0;
     if Msg.wParam > 0 then
       Msg.wParam := VK_UP
     else
       Msg.wParam := VK_DOWN;
     Handled := False;
   end;

Resulta que el maravilloso código de ecfisa no funciona.

¿Habría alguna manera de poder utilizar los dos a la vez?

Vaya, si que se puede. Lo dejo por si a alguien le interesa:

En las Private Declarations

Código Delphi [-]
    { Private declarations }
    procedure DBGrid1PillaLaRueda(var Message: TMessage);
       procedure MMouseEvent(var Msg: TMsg; var Handled: Boolean); {SCROLL DEL DBGRID}

Despues de los Uses y antes de {SR *.DFM}

Código Delphi [-]
type
TomaInvento = class(TControl);

El el OnCreate de la Form

Código Delphi [-]
DBGrid1.WindowProc := DBGrid1PillaLaRueda;
   Application.OnMessage := MMouseEvent; {PARA EL SCROLL DEL DBGRID}

El procedure del Scroll Vertical

Código Delphi [-]
procedure TForm3.DBGrid1PillaLaRueda(var Message: TMessage);
 var
   Cuanto : short;
 begin

   if (Message.Msg = WM_MOUSEWHEEL) then begin
     Cuanto:=HIWORD(Message.WParam);
     Cuanto:=Cuanto div 120;
     DbGrid1.DataSource.DataSet.MoveBy(-Cuanto);

   end else TomaInvento(DBGrid1).WndProc(Message);
 end;

Y por último, después del procedure Vertical, el procedure de Ecfisa para el Scroll Horizontal

Así tenemos los Scroll Vertical y Horizontal sin usar las Barras de Desplazamiento

Muchas gracias