我有
一個TScrollBox 及
一個TImage(Autosize屬性true)

而我像做用掌形來捲動圖片就好了，來取代還要拉TScrollBox的捲軸，請問該如何來下手。


以下是擷取螢幕的畫面，但是滑鼠還沒做掌形拖曳工具
程式有物件
1個TScrollBox、1個TImage(AutoSize屬性為True)、1個TButton
程式有事件
TButton的OnClick

[code delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
DC:hdc;
MyCanvas:TCanVas;
Bmp:TBitMap;
begin
Application.Minimize; //視窗縮到工作列
Sleep(1000);
Application.ProcessMessages;
MyCanvas:=TCanvas.Create;
Bmp:=TBitMap.Create;
Bmp.Width := Screen.Width;
Bmp.Height := Screen.Height;
DC:=getdc(0);
try
MyCanvas.Handle := DC;
Bmp.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height),myCanvas,Rect(0,0,Screen.Width,Screen.Height));
image1.Picture.Bitmap.Assign(Bmp);
finally
Releasedc(0,dc);
MyCanvas.Free;
Bmp.Free;
end;
application.Restore;
end;
end.
[/code]

編輯記錄

您有很多問題尚未結案,請留意
http://delphi.ktop.com.tw/members_question.php?uid=68129

建議您將你已經寫好的部份PO上來,讓前輩們幫您看看如何修改

編輯記錄

可以參考ATImageBox這個元件
http://atorg.net.ru/delphi/atimagebox.htm
要實作拖曳功能請看ATImageBox.pas原始碼


[code delphi]
procedure TATImageBox.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FImageDrag and (Button = mbLeft) then//當按下滑鼠左鍵時
begin
FImageDragging := True; //設定為拖曳模式
FImageDraggingPoint := Point(X, Y); //並紀錄下目前滑鼠位置
Screen.Cursor := FImageDragCursor;
end;
end;
procedure TATImageBox.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FImageDrag and FImageDragging then //在移動滑鼠的時候
begin
HorzScrollBar.Position := HorzScrollBar.Position (FImageDraggingPoint.X - X);
VertScrollBar.Position := VertScrollBar.Position (FImageDraggingPoint.Y - Y);
//更新ScrollBar的位置,並依位移的距離來調整圖片的位置
UpdateImageLabelPosition;
end;
end;
procedure TATImageBox.ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FImageDragging and (Button = mbLeft) then
begin
FImageDragging := False; //取消拖曳模式
Screen.Cursor := crDefault;
end;
end;
[/code]

編輯記錄

http://delphi.about.com/od/adptips2006/qt/panning.htm