wie in Tcustomcontrol auf Scrollen reagieren??

[supermuckl]

Hi!
Ich möchte in einer eigenen classe, die auf Tcustomcontrol aufbaut, auf scrollereignisse (up and down) reagieren können
ich krieg es einfach nicht hin!
Die eigenen objekte liegen auf dem form und haben es auch als parent.

wie kann ich das nun erreichen? das form erhält die scrollevents (als integer 522) aber die selbstinstantiierten controls auf dem form erhalten keine scrollevents (nur alles andere wie z.b. click, mousemove usw)

[Bummi]

Die Klasse etwas aufbohren:

Delphi-Quellcode:

  published
    property OnScrollHorz: TNotifyEvent read FOnScrollHorz write FOnScrollHorz;
    property OnScrollVert: TNotifyEvent read FOnScrollVert write FOnScrollVert;
    property OnWheel: TMyWheelEvent read FOnWheel write FOnWheel;

[supermuckl]

hi
das hat mir jetzt leider nicht weitergeholfen
ich versteh grundsätzlich nicht, wieso keine events an mein customcontrol weitergeleitet werden, die fürs scollen verantwortlich sind
ich hab schon einiges versucht in meiner class und die sieht schon aus wie eine baustelle
ich poste mal wie die aktuell aussieht - katastrophe..

ich will ja keine events selber abfeuern sondern ich will auf events reagieren, die nicht ankommen!

wie kriegt meine tcustomcontrolXYZ mit, daß die maus gerade auf ihr scrollt..

Delphi-Quellcode:

unit poti;

interface

uses sysutils,windows,graphics,messages,controls,mucontrol,background,classes,pngimage;


type Tmupoti = class(Tmucontrol)
//procedure HandleOnMessage(var Msg: TMsg; var Handled: Boolean);
private
parentbackgroundbitmap : Tbitmap;
knop: array[0..1] of TPNGObject;
mdown:boolean;
starty,posy:integer;
mousedownlock:boolean;
fstyle:integer;
fsenserect:Trect;
fmousepos:tpoint;
fmouseover:boolean;
frotationangle:extended;
procedure incangle(value:extended);
public

procedure Repaint; override;
procedure GetParentBackground;
constructor Create(owner:Tcontrol;style:integer);

procedure DefaultHandler(var Message); override;
procedure test(var Message); message 999;
Procedure WndProc(Var Msg: TMessage); Override;

protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
//procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
//procedure MouseWheelHandler(var Message: TMessage); override;
//procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;

end;

implementation
      uses unit2;


Procedure Tmupoti.WndProc(Var Msg: TMessage);
Begin
  //  If Msg.Msg = 999 Then
  //  Begin
 try
  tmp.add(inttostr(Msg.Msg));
   form2.ListBox1.Items := tmp;
  except end;
  //  End;
    Inherited;
End;

procedure Tmupoti.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft then begin

 mdown := true;
 if not mousedownlock then begin
 starty := y;
 posy := y;
 end;
 mousedownlock := true;
 forcerepaint := true;
 paint;
end;
end;

procedure Tmupoti.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbleft then begin
 mdown := false;
 mousedownlock := false;
 forcerepaint := true;
 paint;
end;
end;

procedure Tmupoti.MouseMove(Shift: TShiftState; X, Y: Integer);
var
inc:extended;
begin
 fmousepos := point(x,y);
 fmouseover := inrect(fsenserect,fmousepos);
 if mdown then begin
 posy := y;
 inc := ((starty-posy)*0.8);
 incangle(inc);


 starty := y;
 end;
 forcerepaint := true;
 paint;
end;

procedure Tmupoti.CMMouseLeave(var Msg: TMessage);
begin
 fmouseover := false;
 forcerepaint := true;
 paint;
    inherited;
end;

procedure Tmupoti.DefaultHandler(var Message);
begin
  if TMessage(Message).Msg = WM_MOUSEHWHEEL then
  incangle(4);
 try
  tmp.add(inttostr(TMessage(Message).Msg));
   form2.ListBox1.Items := tmp;
  except end;
  inherited DefaultHandler(Message);
end;

procedure Tmupoti.test(var Message);
begin
  if TMessage(Message).Msg = WM_MOUSEHWHEEL then
  incangle(4);
 try
  tmp.add(inttostr(TMessage(Message).Msg));
   form2.ListBox1.Items := tmp;
  except end;
end;

    {
procedure Tmupoti.MouseWheelHandler(var Message: TMessage);
begin
 if Message.wParam > 0 then incangle(4) else incangle(-4);

 forcerepaint := true;
 paint;
    inherited;
end;

procedure Tmupoti.WMVScroll(var Message: TWMVScroll);
begin
if Message.ScrollCode > 0 then incangle(4) else incangle(-4);


end;  }

               {
procedure Tmupoti.WMMOUSEWHEEL(var Msg: TMessage);
begin
if Msg.wParam > 0 then incangle(4) else incangle(-4);


end;

procedure Tmupoti.HandleOnMessage(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.message of
      WM_MOUSEWHEEL:
      begin
        if Msg.wParam > 0 then incangle(4) else incangle(-4);

        handled := true;
      end;
end;
end;      }


procedure Tmupoti.incangle(value:extended);
begin
if (frotationangle+value < 180) and (frotationangle+value > -180) then frotationangle := frotationangle+value;

end;


procedure Tmupoti.GetParentBackground;
begin
 if self.Parent <> nil then begin
   //Tmubkg(self.Parent).upimg.SaveToFile('c:\upimg.bmp');
   bitblt(parentbackgroundbitmap.canvas.Handle,0,0,parentbackgroundbitmap.width,parentbackgroundbitmap.Height,Tmubkg(self.Parent).upimg.canvas.handle,self.Left*4,self.Top*4,SRCCOPY);
   //parentbackgroundbitmap.SaveToFile('c:\parentbackgroundbitmap.bmp');
 end;

end;


procedure Tmupoti.Repaint;
var
middlex,middley:integer;
_rect:Trect;
tmppng:Tpngimage;
begin

upimg.Canvas.Draw(0,0,parentbackgroundbitmap);
// zeichnen
middlex := upimg.Width div 2;
middley := upimg.Height div 2;
tmppng := Tpngimage.Create;
tmppng.Assign(knop[0]);
SmoothRotate(tmppng, frotationangle);

with upimg.Canvas do begin


// brush.Color := clmaroon;
//if mdown then brush.Style := bssolid else brush.Style := bsclear;
//rectangle(cliprect);
brush.Style := bsclear;
pen.Color := clsilver;
pen.Width := 4;


_rect := rect(fsenserect.Left*4,fsenserect.top*4,fsenserect.right*4,fsenserect.bottom*4);
inflaterect(_rect,16,16);
if fmouseover or mdown then begin
 roundrect(_rect,32,32);
 cursor := crHandPoint;
end else begin

cursor := crDefault;
end;

pen.Color := clwhite;
pen.Width := 4;
   {
moveto(middlex,0);
lineto(middlex,height*4);
moveto(0,middley);
lineto(width*4,middley);

font.Color := clyellow;
font.Height := 100;
textout(2,2,inttostr(starty-posy));  }

draw(middlex-(tmppng.Width div 2) ,middley-(tmppng.height div 2),tmppng);
draw(middlex-(knop[1].Width div 2) ,middley-(knop[1].height div 2),knop[1]);

end;



//auf standard img kopieren und downsamplen
img.Assign(upimg);
Downsample4xBitmap24(img);

tmppng.Free;

end;



constructor Tmupoti.Create(owner:Tcontrol;style:integer);
var
i:integer;
begin
  inherited create(owner);
  //ControlStyle := [csCaptureMouse, csClickEvents, csDesignInteractive];
  fstyle := style;
  parentbackgroundbitmap := Tbitmap.Create;
  for i := 0 to length(knop) - 1 do begin
  knop[i]:=TPNGObject.Create;
  end;

  case fstyle of
  1: begin
     self.Height := 42;
     self.width := 42;
     knop[0].LoadFromFile('C:\drehknopf.png');
     knop[1].LoadFromFile('C:\drehknopf_schatten.png');
     SmoothResize(knop[0],self.width*4,self.height*4);
     SmoothResize(knop[1],self.width*4,self.height*4);
     end;
  end;

  img.Height :=  self.Height;
  img.width :=  self.width;
  upimg.Height :=  self.Height*4;
  upimg.width :=  self.width*4;
  parentbackgroundbitmap.Width := self.width*4;
  parentbackgroundbitmap.Height := self.height*4;
  parentbackgroundbitmap.PixelFormat := pf24bit;
  fsenserect := rect(0,0,self.width,self.height);
  inflaterect(fsenserect,-8,-8);





  //knop[1].LoadFromFile('C:\test2-red.png');
 //  SmoothRotate(knop[0], 90);
 //  SmoothRotate(knop[0], 90);
 //  knop[0].SaveTofile('C:\drehknopftest.png');

end;


end.

[Bummi]

vielleicht fehlt ein SetFocus, folgendes geht bei mir

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TWheelDir=Procedure(Direction:Integer) of Object;
  TMyClass=Class(TCustomControl)
  private
    FOnMouseWheel: TWheelDir;
  published
  procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;

  published
  Property OnMouseWheel:TWheelDir read FOnMouseWheel write FOnMouseWheel ;
  End;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure Wheel(dir:Integer);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyClass }

procedure TMyClass.WMMOUSEWHEEL(var Msg: TMessage);
begin

    if Assigned(FOnMouseWheel) then FOnMouseWheel(msg.WParam);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  With TMyClass.Create(self) do
    begin
      Parent := Self;
      Left := 0;
      Top := 0;
      Width := 200;
      Height := 200;
      SetFocus;
      OnMouseWheel := Wheel;
    end;
end;
procedure TForm1.Wheel(dir:Integer);
begin
  Caption := IntToStr(dir div ABS(dir));
end;
end.

[supermuckl]

sehr gut!
es hat NUR der focus gefehlt
- die objekte wurden im on create des forms erstellt und da konnte man dann auch keinen focus setzen da die objekte noch nicht sichtbar waren aber ich hab das jetzt so geregelt, das der focus automatisch gesetzt wird, wenn die maus über dem control sitzt (if fmouseover then setfocus;)

vielen dank!

[OldGrumpy]

Das mit dem Focus sollte man im Auge behalten, denn früher oder später kommt der Wunsch auf, ein Control auch dann mit Mausrad bedienen zu wollen wenn die Maus nicht drauf steht.

Wie das geht ist simpel: Die Mausrad-Events gehen an das Parent-Control und werden dort ggf. an das Control weitergeleitet, das gerade den Focus hat. Hier kann man also eingreifen und die Mausrad-Events immer an ein bestimmtes Control durchreichen.