Auf Scrollen reagieren

[Sanchez]

hallo erstmal,

Gibt es eine Möglichkeit bei einer TScrollbox, auf das Scrollen zu reagieren. Ich möchte die Scrollbox nach dem Scrollen neu zeichnen.

OnScroll - event gibts ja keines.

mfg Daniel

[Sanchez]

Geh ich recht in der Annahme, dass mir nix anderes übrigbleibt als eine Kompo von einer Scrollbox abzuleiten und einen Messagehandler fürs Scrollen anzufügen?

mfg Daniel

[Christian Seehase]

Moin Sanchez,

wenn Du das öfter brauchst wäre das vielleicht ganz sinnvoll.
Ansonsten könntest Du das aber vielleicht auch ganz einfach so nachrüsten (ich weiss die Message leider nicht )

Delphi-Quellcode:

TForm1 = class(TForm)
  //...
  procedure MyScrollEvent(var msg : TMessage); message SO_WIE_DIE_MESSAGE_HEISST;
  //...
end;

//...

implementation

procedure TForm1.MyScrollEvent(var msg : TMessage);
begin
  // Was beim Scrollen passieren soll
end;

Sollte das nicht gehen, kann man sich auch noch in die WindowProc des Controls oder des übergeordneten Fensters (kann auch ein Control sein)einklinken. (letzteres hab' ich z.B. für CBN_CLOSEUP nicht anders hinbekommen )

[Luckie]

WM_HSCROLL, WM_VSCROLL eventuell?

[Christian Seehase]

Moin Luckie,

da könntest Du durchaus recht haben

Ich kam einfach nicht drauf

[Sanchez]

Wenn mein Form diese beiden Prozeduren bekommt

Delphi-Quellcode:

procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL; 
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

laufen sie nur, wenn das Form gescrollt wird, ich möchte aber aufs Scrollen der Scrollbox die im Form steckt reagieren

mfg Daniel

[Jens Schumann]

Hallo,
so könnte der Source einer solchen Komponente aussehen:

Delphi-Quellcode:

unit ScrollBoxEx;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

Const
  CM_SCROLLBOXEXVERTSCROLL  = WM_USER+512;
  CM_SCROLLBOXEXHORIZSCROLL = WM_USER+513;

type

  TScrollEvent = procedure (Sender : TObject; Position : Integer) of Object;

  TScrollBoxEx = class(TScrollBox)
  private
    FOnVScroll : TScrollEvent;
    FGroupIndex: Integer;
    fOnHScroll: TScrollEvent;
    procedure SetGroupIndex(const Value: Integer);
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure CMSCROLLBOXEXVERTSCROLL(var Message: TMessage); message CM_SCROLLBOXEXVERTSCROLL;
    procedure CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage); message CM_SCROLLBOXEXHORIZSCROLL;
    { Private-Deklarationen }
  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    constructor Create(AOwner : TComponent); override;
  published
    { Published-Deklarationen }
    property GroupIndex : Integer read FGroupIndex write SetGroupIndex default 0;
    property OnVScroll : TScrollEvent read fOnVScroll write fOnVScroll;
    property OnHScroll : TScrollEvent read fOnHScroll write fOnHScroll;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Mycomps', [TScrollBoxEx]);
end;

{ TScrollBoxEx }

constructor TScrollBoxEx.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FGroupIndex:=0;
  fOnVScroll:=Nil;
end;

procedure TScrollBoxEx.SetGroupIndex(const Value: Integer);
begin
  FGroupIndex := Value;
end;

procedure  TScrollBoxEx.WMHScroll(var Message: TWMHScroll);
var
  Msg: TMessage;
begin
  inherited;
  If Assigned(fOnHScroll) then
    fOnHScroll(Self,Message.Pos);
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_SCROLLBOXEXHORIZSCROLL;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure  TScrollBoxEx.WMVScroll(var Message: TWMVScroll);
var
  Msg: TMessage;
begin
  inherited;
  If Assigned(fOnVScroll) then
    fOnVScroll(Self,Message.Pos);
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_SCROLLBOXEXVERTSCROLL;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TScrollBoxEx.CMSCROLLBOXEXVERTSCROLL(var Message: TMessage);
var
  Sender: TScrollBoxEx;
begin
  inherited;
  If FGroupIndex<=0 then Exit;
  if Message.WParam = FGroupIndex then
  begin
    Sender := TScrollBoxEx(Message.LParam);
    if Sender <> Self then
    begin
    VertScrollBar.Position:=Sender.VertScrollBar.Position;
    end;
  end;
end;

procedure TScrollBoxEx.CMSCROLLBOXEXHORIZSCROLL(var Message: TMessage);
var
  Sender: TScrollBoxEx;
begin
  inherited;
  If FGroupIndex<=0 then Exit;
  if Message.WParam = FGroupIndex then
  begin
    Sender := TScrollBoxEx(Message.LParam);
    if Sender <> Self then
    begin
    HorzScrollBar.Position:=Sender.HorzScrollBar.Position;
    end;
  end;
end;

end.

Über die Eigenschaft GroupIndex können mehrere Scrollboxen gekoppelt werden. Wie das aussieht kann man in der Anlage sehen.

[Sanchez]

Danke, die Kompo funktioniert wunderbar. Genau was ich gebraucht habe.

mfg Daniel