图像拖动，白送的100分，谁要谁先进！不行再加100，谁来取？ (100分)

大图像上有个小图像，用鼠标移动小图像，快说说吧！

是想在大图像透明显示移动小图像吗？用两个图像叠加试试吧！

就是在上边拖动，快说怎么办？

先保存小图当前范围内的大图图象
拖动的时候先用xor方法画一虚框
小图移动时也只是重画这个虚框
到鼠标放开的时候再将小图画在鼠标当前位置
并将开始保存的那块大图图象重新画出

该方法即占用内存少，也解决了大图重画时闪烁的问题

能不能谘细点，在图像上如何响应这一事件？

学习学习学习！！

www.playico.com上在一个这样的例子，你可以上去下下

playico上不去

procedure TForm1.image2MouseMove(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
image2.Perform(WM_SYSCOMMAND, $f017, 0);
end;

不明白，试了不行

先给你个简单的
在form1上放image1（大图象）,image2（小图象）
再给image2添加下边的程序

var
oldx,oldy:integer;
moused:boolean=false;

procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if moused then
begin
image2.Left:=image2.left+x-oldx;
image2.top:=image2.top+y-oldy;
end;
end;

procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
oldx:=x;
oldy:=y;
moused:=true;
end;

procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
moused:=false;
end;

咳，翻点旧东西缵点钱，整个控件，解决移动，按比例缩放>>>>>>>>
//YUKI 2002-12-28

unit ImageYuki;

interface

uses Messages, Windows, Classes, Controls, Forms, Graphics;
type
TImageYuki = class(TGraphicControl)
private
FalClient: Boolean;
Fbmp: TBitmap;
FSize: Double;
FPicture: TPicture;
FOnProgress: TProgressEvent;
PicChanged_Boolean: Boolean;
FStretch: Boolean;
FCenter: Boolean;
FIncrementalDisplay: Boolean;
FTransparent: Boolean;
FDrawing: Boolean;
FProportional: Boolean;
FAutoMove: Boolean;
CanMove: Boolean;
OldX, OldY: Integer;
procedure PicChanged(Sender: TObject);
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetClient(Value: Boolean);
procedure SetSize(Value: Double);
procedure SetPicture(Value: TPicture);
procedure SetAutoMove(Value: Boolean);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure SetProportional(Value: Boolean);
// procedure WMMouseWheel(var Message_s: TWMMouseWheel); message WM_MOUSEWHEEL;
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint; override;
procedure Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
dynamic;
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;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetCanvas: TCanvas;
// property Canvas: TCanvas read GetCanvas;
published
property Align;
property Anchors;
property AutoSize;
property Client: Boolean read FalClient write SetClient default False;
property Center: Boolean read FCenter write SetCenter default False;
property Size: Double read FSize write SetSize;
property AutoMove: Boolean read FAutoMove write SetAutoMove;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property IncrementalDisplay: Boolean read FIncrementalDisplay write
FIncrementalDisplay default False;
property ParentShowHint;
property Picture: TPicture read FPicture write SetPicture;
property PopupMenu;
property Proportional: Boolean read FProportional write SetProportional
default false;
property ShowHint;
property Stretch: Boolean read FStretch write SetStretch default False;
property Transparent: Boolean read FTransparent write SetTransparent default
False;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
property OnStartDock;
property OnStartDrag;
end;

procedure Register;
function GetMoveBoundsRect(InRect: TRect; FWidth, FHeight: Integer; Center:
Boolean = true): TRect;

implementation

{
procedure TImageYuki.WMMouseWheel(var Message_s: TWMMouseWheel);
begin
case Message_s.WheelDelta of
-120: Top := Top + 10;
120: Top := Top - 10;
-240: Left := Left + 10;
240: Left := Left - 10;
else
end;
end; }

procedure TImageYuki.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
CanMove := False;
end;

procedure TImageYuki.MouseMove(Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
if CanMove then
begin
R.Left := Left + X - OldX;
r.Top := Top + Y - OldY;
r.Right := r.Left + Width;
r.Bottom := r.Top + Height;
r := GetMoveBoundsRect(r, Parent.Width, Parent.Height);
if r.Left = Left then
OldX := X;
if r.Top = top then
OldY := Y;
BoundsRect := r;
end;
end;

procedure TImageYuki.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
if FAutoMove and (Button = mbLeft) then
begin
CanMove := True;
OldX := X;
OldY := Y;
end;
end;

constructor TImageYuki.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FPicture := TPicture.Create;
// FPicture.OnChange := PictureChanged;
FPicture.OnChange := PicChanged;
FPicture.OnProgress := Progress;
Height := 105;
Width := 105;
FSize := 1;
Fbmp := TBitmap.Create;
// bmp.Canvas.Brush.Color := clBlack;
// bmp.Canvas.Rectangle(BoundsRect);
end;

destructor TImageYuki.Destroy;
begin
FPicture.Free;
Fbmp.Free;
inherited Destroy;
end;

function TImageYuki.GetPalette: HPALETTE;
begin
Result := 0;
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;

function TImageYuki.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := Picture.Width;
h := Picture.Height;
if not Proportional then
begin
w := ROUND(w * FSize);
h := ROUND(h * FSize);
end;
if FalClient then
begin
cw := Parent.ClientWidth;
ch := Parent.ClientHeight;
end
else
begin
cw := ClientWidth;
ch := ClientHeight;
end;
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
begin
if Proportional and (w > 0) and (h > 0) then
begin
xyaspect := w / h;
if w > h then
begin
w := cw;
h := Trunc(cw / xyaspect);
if h > ch then // woops, too big
begin
h := ch;
w := Trunc(ch * xyaspect);
end;
end
else
begin
h := ch;
w := Trunc(ch * xyaspect);
if w > cw then // woops, too big
begin
w := cw;
h := Trunc(cw / xyaspect);
end;
end;
end
else
begin
w := cw;
h := ch;
end;
end;

with Result do
begin
Left := 0;
Top := 0;
Right := w;
Bottom := h;
end;

if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;

procedure TImageYuki.Paint;
var
Save: Boolean;
begin
Save := FDrawing;
FDrawing := True;
if FalClient then
BoundsRect := DestRect
else if FAutoMove then
BoundsRect := GetMoveBoundsRect(BoundsRect, Parent.Width, Parent.Height);
// Canvas.Draw(0, 0, fbmp);
//Canvas.StretchDraw(r, Picture.Graphic);
SetStretchBltMode(Canvas.Handle, HALFTONE);
StretchBlt(Canvas.Handle, 0, 0, Width, Height,
fbmp.Canvas.Handle, 0, 0, Picture.Width, Picture.Height, SRCCOPY);
FDrawing := Save;
end;

function TImageYuki.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := Picture.Graphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
(Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and
Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;

procedure TImageYuki.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then
Update
else
Paint;
end;
if Assigned(FOnProgress) then
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

function TImageYuki.GetCanvas: TCanvas;
resourcestring
SImageCanvasNeedsBitmap = 'Can only modify an image if it contains a bitmap';
var
Bitmap: TBitmap;
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;

procedure TImageYuki.SetClient(Value: Boolean);
begin
if FalClient <> Value then
begin
FalClient := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetSize(Value: Double);
begin
if 0 > Value then
Value := 0;
if (FSize <> Value) then
begin
FSize := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetAutoMove(Value: Boolean);
begin
if FAutoMove <> Value then
begin
FAutoMove := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure TImageYuki.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.SetProportional(Value: Boolean);
begin
if FProportional <> Value then
begin
FProportional := Value;
PictureChanged(Self);
end;
end;

procedure TImageYuki.PicChanged(Sender: TObject);
begin
PicChanged_Boolean := not PicChanged_Boolean;
if Picture.Graphic = nil then
PicChanged_Boolean := false;
if (Picture.Graphic = nil) or (PicChanged_Boolean) then
PictureChanged(Sender);
end;

procedure TImageYuki.PictureChanged(Sender: TObject);
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
//Picture.Graphic.Transparent := FTransparent;
ControlStyle := ControlStyle + [csOpaque];
fbmp.Assign(Picture.Graphic);
if not FDrawing then
Paint;
end;

function TImageYuki.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and
(Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
if not Proportional then
begin
NewWidth := abs(ROUND(NewWidth * FSize));
NewHeight := abs(ROUND(NewHeight * FSize));
end;
end;
end;

function GetMoveBoundsRect(InRect: TRect; FWidth, FHeight: Integer; Center:
Boolean = true): TRect;
var
W, H: Integer;
begin
w := InRect.Right - InRect.Left;
h := InRect.Bottom - InRect.Top;
Result := InRect;
if (Result.Bottom < FHeight) and (Result.Top < 0) then
Result.Top := FHeight - (InRect.Bottom - InRect.Top);
if (Result.Right < FWidth) and (Result.Left < 0) then
Result.Left := FWidth - (InRect.Right - InRect.Left);
if (Result.Top > 0) then
Result.Top := 0;
if (Result.Left > 0) then
Result.Left := 0;
if Center then
begin
if w < FWidth then
Result.Left := (FWidth - w) div 2;
if h < FHeight then
Result.Top := (FHeight - h) div 2;
end;
Result.Bottom := Result.Top + h;
Result.Right := Result.Left + w;
end;

procedure Register;
begin
RegisterComponents('YUKI', [TImageYuki]);
end;
end.