Ver Mensaje Individual
  #22  
Antiguo 21-04-2008
Avatar de enecumene
[enecumene] enecumene is offline
Miembro de Oro
 
Registrado: may 2006
Ubicación: Santo Domingo, Rep. Dom.
Posts: 3.040
Reputación: 24
enecumene Va por buen camino
Saludos Compañeros, La cosa va así, he implementado un nuevo procedimiento y se trata de mover registros con la rueda del Ratón, o sea, lo que haces cuando las teclas ARRIBA/ABAJO para moverse entre registros y que ahora se puede hacer con el mouse, he aquí el código:

Código Delphi [-]
{ DBGrilla v1.0                                                   }
{ Grilla basado en los códigos de Neftalí y Román ClubDelphi.com  }
{ Tiene las siguientes Características:                           }
{ Scroll Automatico : Los Scroll Vertical y horizontal aparecerán }
{ cuando sea necesario.                                           }
{ VerticalScroll : Puedes activar o desactivar el scroll Vertical.}
{ HorizontalScroll : ¿no hay que explicarlo verdad?.              }
{ Componente realizado por Enecumene para ClubDelphi.com.         }

unit DBGrilla1;

interface

uses
  SysUtils, Classes, Controls, Grids, DBGrids, Messages, windows, DBTables, Dialogs,
  DB;

type
  TMouse = class(TControl);
  TDBGrilla = class(TDBGrid)
  private
    FValorVertical: Boolean;
    FValorHorizontal: Boolean;
    FScrollAutomatico: Boolean;

    procedure WMNCCalcSize(var msg: TMessage); message WM_NCCALCSIZE;
    procedure MouseScroll(var msg: TMessage); message WM_MOUSEWHEEL;
  protected
      procedure setAutomaticScroll(Value: Boolean);
      procedure setVerticalScrollBar(Value: Boolean);
      procedure setHorizontalScrollBar(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property VerticalScrollBar: Boolean read FValorVertical write setVerticalScrollBar;
    property HorizontalScrollBar: Boolean read FValorHorizontal write setHorizontalScrollBar;
    property AutomaticScroll: Boolean read FScrollAutomatico write setAutomaticScroll;
  end;

procedure Register;

implementation

constructor TDBGrilla.Create(AOwner: TComponent);
begin
  WindowProc := MouseScroll;
    inherited;
end;

procedure TDBGrilla.MouseScroll(var msg: TMessage);
Var Cuanto: short;
begin
  if (Msg.Msg = WM_MOUSEWHEEL) then begin
     Cuanto:=HIWORD(Msg.WParam);
     Cuanto:=Cuanto div 120;
     if Assigned(DataSource) and Assigned(DataSource.DataSet) then
     begin
     DataSource.DataSet.MoveBy(-Cuanto);
     end;
   end else TMouse(TDBGrilla).WndProc(Msg);
end;

procedure TDBGrilla.setAutomaticScroll(Value: Boolean);
begin
  if Value <> FScrollAutomatico then
  begin
    FScrollAutomatico := Value;
  end;
end;

procedure TDBGrilla.setVerticalScrollBar(Value: Boolean);
begin
  if Value <> FValorVertical then
  begin
    FValorVertical := Value;
  end;
end;

procedure TDBGrilla.setHorizontalScrollBar(Value: Boolean);
begin
  if Value <> FValorHorizontal then
  begin
    FValorHorizontal := Value;
  end;
end;

procedure TDBGrilla.WMNCCalcSize(var msg: TMessage);
var
  style: Integer;
begin
if VerticalScrollBar then
  begin
  style := getWindowLong( handle, GWL_STYLE );

  if (style and WS_HSCROLL) <> 0 then
    SetWindowLong( handle, GWL_STYLE, style and not WS_HSCROLL );
  if (style and WS_VSCROLL) <> 0 then
    SetWindowLong( handle, GWL_STYLE, style and not WS_VSCROLL );
  end;
if HorizontalScrollBar then
  begin
  style := getWindowLong( handle, GWL_STYLE );

  if (style and WS_VSCROLL) <> 0 then
    SetWindowLong( handle, GWL_STYLE, style and not WS_VSCROLL );
  if (style and WS_HSCROLL) <> 0 then
    SetWindowLong( handle, GWL_STYLE, style and not WS_HSCROLL );
  end;
if AutomaticScroll then
  begin
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
    begin
      Style := GetWindowLong(Handle, GWL_STYLE);

      if DataSource.DataSet.RecordCount > VisibleRowCount then
       Style := Style or WS_VSCROLL
      else
       Style := Style and not WS_VSCROLL;

      SetWindowLong(Handle, GWL_STYLE, Style);
  end;
end;
  inherited;
end;

procedure Register;
begin
  RegisterComponents('Data Controls', [TDBGrilla]);
end;

end

Saludos
__________________

Mi BLOG - ¡Joder, leanse la guia de estilo!
Las Palabras son enanas, los ejemplos gigantes.
Responder Con Cita