Einzelnen Beitrag anzeigen

supermuckl

Registriert seit: 1. Feb 2003
1.340 Beiträge
 
FreePascal / Lazarus
 
#3

AW: wie in Tcustomcontrol auf Scrollen reagieren??

  Alt 31. Dez 2010, 13:56
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.
Das echte Leben ist was für Leute...
... die im Internet keine Freunde finden!
  Mit Zitat antworten Zitat