02. oktober 2004 - 07:32
Der er
5 kommentarer og
1 løsning
Flimmer ved flytning af image
Hej
Jeg har lavet en rutine til at flytte et image rundt på skærmen
og det virker sådan set godt nok
men når jeg flytter imaget så " flimmer " billedet
hvad kan der være galt
eller er der en anden måde at gøre det på
her er min rutine :
procedure THovedeForm.Image2MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
StartX := X;
StartY := Y;
MuseKnapNede := 1;
Label1.Caption := inttostr(X);
Label2.Caption := inttostr(Y);
end;
procedure THovedeForm.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//Image2.Top := Y;
//Image2.Left := X;
MuseKnapNede := 0;
end;
procedure THovedeForm.Image2MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
If MuseKnapNede = 1 then
begin
if Y <> StartY then //flytter image ned
Begin
if Y > StartY then
begin
Image2.top := Image2.Top +5;
end
else
begin //flytter image op
Image2.top := Image2.Top -5;
end;
end;
if X <> StartX then //flytter image mod højre
Begin
if X > StartX then
begin
Image2.Left := Image2.Left +5;
end
else
begin //flytter image mod venstre
Image2.Left := Image2.Left -5;
end;
end;
end;
end;
end.
03. oktober 2004 - 09:27
#2
Det er bedre at tegne et flyttefelt på formens canvas og først flytte billedet når man slipper museknappen.
Prøv nedenstående kode hvor jeg har et TImage på en form.:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, jpeg;
type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
XStart,YStart:integer;
A, B, C, D: TPoint;
const
CanMoveObject: Boolean = false;
implementation
{$R *.DFM}
procedure TegnFigur(PenMode: TPenMode; PenColor: integer; Penwidth: integer);
begin
with Form1.Canvas do
begin
Pen.Mode := PenMode;
Pen.Width := 0;
Pen.color := Pencolor;
PolyLine([A, B, D, C, A]);
end;
end;
procedure FeltTilBillede;
begin
A.X := Form1.Image1.left;
A.Y := Form1.Image1.top;
B.X := A.X + Form1.Image1.width;
B.Y := A.Y;
C.X := A.X;
C.Y := A.Y + Form1.Image1.Height;
D.X := B.X;
D.Y := C.Y;
end;
procedure TegnFlyttefelt(X, Y: integer);
begin
if CanMoveObject then
begin
TegnFigur(pmNotXor, clBlack, 1); //tegner
A.X := Form1.Image1.Left + (X - XStart);
A.Y := Form1.Image1.Top + (y - YStart);
B.X := A.X + Form1.Image1.width;
B.Y := A.Y;
C.X := A.X;
C.Y := A.Y + Form1.Image1.Height;
D.X := B.X;
D.Y := C.Y;
TegnFigur(pmNotXor, clBlack, 1); //sletter igen
end;
end;
procedure BilledeTilFelt;
begin
Form1.Image1.top := A.Y;
Form1.Image1.Left := A.X;
Form1.Image1.Width := B.X - A.X;
Form1.Image1.Height := C.Y - A.Y;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CanMoveObject := true;
FeltTilBillede;
XStart := X;
YStart := Y;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
CanMoveObject := false;
BilledeTilFelt;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if CanMoveObject then TegnFlyttefelt(X,Y);
end;
end.
03. oktober 2004 - 12:18
#4
Hej Arnold
Jeg har lige checket min kode og får ingen fejl selv.
Har du kopieret koden over som den står.
Jeg checkede koden fra EKSPERTEN sådan:
Jeg startede med at indsætte et TImage på Form1 og oprettede derefter procedurene:
Image1MouseUp, Image1MouseDown og Image1MouseMove ved at dobbeltklikke i object inspectoren på de relevante EVENTS.
Derefter slettede jeg hele koden og kopierede koden fra Eksperten.
Så prøv igen.
Med venlig hilsen
Erik
04. oktober 2004 - 13:43
#5
Du kan også undlade at flytte billedet før musen er flyttet lidt mere end 1 pixel, det gør det meget mere flydende.
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If MuseKnapNede = 1 then
begin
if abs(Y-StartY)>=5 then {***}
Begin
if Y > StartY then
begin
Image2.top := Image2.Top +5;
end
else
begin
Image2.top := Image2.Top -5;
end;
StartY := Y; {***}
end;
if abs(X-StartX)>=5 then {***}
Begin
if X > StartX then
begin
Image2.Left := Image2.Left +5;
end
else
begin
Image2.Left := Image2.Left -5;
end;
StartX := X; {***}
end;
end;
end;
04. oktober 2004 - 13:49
#6
Eller lidt simplere:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If MuseKnapNede = 1 then
if ((abs(Y-StartY)>=5) or (abs(X-StartX)>=5)) then
Begin
Image2.top := Image2.Top + Y - StartY;
Image2.Left := Image2.Left + X - StartX;
StartY := Y;
StartX := X;
end;
end;