TCustomControl brauche hilfe^^

[EugenE]

Hallo Leute,

nach einer langen Lazarus-Freien-Zeit hab ich wiedermal lust irgendwas zu programmieren^^

Also zum Problem

Habe einfach mal eine neue Klasse erstellt die TCustomControl erweitert so, die MouseOver,MouseDown und MouseUp habe ich überschrieben

Dort soll das Bild( nur ein Rechteck zurzeit) an die Position wo die Maus grade ist verschoben werden.

Nur wenn ich es anklicke und verschiebe wird es ca 4 mal angezeigt , mal nur 3 und es kommt nicht richtig mit

Naja das Problem kann man nicht so richtig erklären^^ darum hab ich das Programm auch mit hochgeladen^^

Quellcodes:
main.pas

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Test := TCard.Create(Self);
  Test.Parent := Self;
  Test.DoubleBuffered := True;
  Test.Height:= 80;
  Test.Width:=40;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Test.Free;
end;

card.pas

Code: Alles auswählen

unit card;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Controls, Graphics, LCLType;
 
type
  TCard = class( TCustomControl )
  public
    angeklickt:Boolean;
    Constructor Create(aowner: tcomponent); Override;
    procedure Paint; override;
    procedure MouseDown(Button:TMouseButton;Shift: TShiftState; X,Y: Integer);  override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer);  override;
    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
  end;
 
implementation
 
Constructor TCard.create(aowner: tcomponent);
Begin
  Inherited create(aowner);
  ControlStyle := ControlStyle + [csOpaque];
End;
 
procedure TCard.Paint;
var
  x, y: Integer;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    // Initialisiert die Bitmap Größe
    Bitmap.Height := Height;
    Bitmap.Width := Width;
 
    // Zeichnet den Hintergrund
    Bitmap.Canvas.Pen.Color := clWhite;
    Bitmap.Canvas.Rectangle(0, 0, Width, Height);
 
    // Zeichnet squares
    Bitmap.Canvas.Pen.Color := clBlack;
    Bitmap.Canvas.Rectangle(0, 0,40, 80);
 
    Canvas.Draw(0, 0, Bitmap);
    Canvas.TextOut(2,2,IntToStr(Self.Top));
    Canvas.TextOut(2,42,IntToStr(Self.Left));
  finally
    Bitmap.Free;
  end;
 
  inherited Paint;
end;
 
procedure TCard.MouseDown(Button:TMouseButton;Shift: TShiftState; X,Y: Integer);
begin
  inherited MouseDown(Button,Shift, X, Y);
  angeklickt:=true;
end;
 
procedure TCard.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if angeklickt then begin
  inherited MouseMove(Shift, X, Y);
   Self.Left:=x; Self.Top:=y;
   Invalidate;
  end;
end;
 
procedure TCard.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
  inherited MouseUp(button,Shift, X, Y);
  angeklickt:=false;
end;
 
end.

[EugenE]

Hab eine Lösung gefunden, funktioniert super

http://newsgroups.derkeiler.com/Archive ... 00903.html" onclick="window.open(this.href);return false;

Thread kann geschlossen werden^^