简单问题,顶者有分!

Question

一个画图程序,在一坐标系内实现画线,坐标系可移动,标签.
可移动是指坐标轴上的点的间距可以根据鼠标的拉拽变化以及整个坐标系的移动!
那位大虾请指点用什么控件实现,有类似代码最好!万分感谢.

Answer 1

unit MainUnit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;const
  PicWidth=800;
  PicHeight=900;
type
  TMoveState=(msNone,msDrawLine,msMoveOrigin);
  TFPoint=record
    X,Y:Double;
  end;
  TLine=record
    P1,P2:TFPoint;
    Color:TColor;
  end;
  TPLine=^TLine;
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    NewFileBtn: TBitBtn;
    ExitBtn: TBitBtn;
    Image1: TImage;
    XScaleSB: TScrollBar;
    YScaleSB: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure XScaleSBChange(Sender: TObject);
    procedure YScaleSBChange(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Origin:TFPoint;
    LastPos:TFPoint;
    XStep,YStep:Integer;
    XScale,YScale:Double;
    MoveState:TMoveState;
    Lines:TList;
    procedure MapPoint(var Point:TFPoint);
    procedure DrawCoord;
    procedure DrawLines;
  end;
var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.DrawCoord;
var
  x,y:Double;
begin
  with Image1,Canvas do
  begin
    Pen.Color:=clWhite;
    Brush.Color:=clWhite;
    Brush.Style:=bsSolid;
    Rectangle(ClientRect);
    Pen.Color:=clBlack;
    x:=Origin.X-XStep;
    while Round(x*XScale)>0 do
    begin
      MoveTo(Round(X*XScale),0);
      LineTo(Round(X*XScale),Height);
      x:=x-XStep;
    end;
    x:=Origin.X+XStep;
    while Round(x*XScale)<Width do
    begin
      MoveTo(Round(X*XScale),0);
      LineTo(Round(X*XScale),Height);
      x:=x+XStep;
    end;
    y:=Origin.Y-YSTep;
    while Round(y*YScale)>0 do
    begin
      MoveTo(0,Round(y*YScale));
      LineTo(Width,Round(y*YScale));
      y:=y-YStep;
    end;
    y:=Origin.Y+YStep;
    while Round(y*YScale)<Height do
    begin
      MoveTo(0,Round(y*YScale));
      LineTo(Width,Round(y*YScale));
      y:=y+YStep;
    end;
    Pen.Color:=clBlue;
    MoveTo(0,Round(Origin.Y*YScale));
    LineTo(Width,Round(Origin.Y*YScale));
    MoveTo(Round(Origin.X*XScale),0);
    LineTo(Round(Origin.X*XScale),Height);
  end;
end;procedure TForm1.DrawLines;
var
  i:Integer;
begin
  for i:=0 to Lines.Count-1 do
  begin
    with Image1,Canvas do
    begin
      with TPLine(Lines.Items[i])^ do
      begin
        Color:=clRed;
        MoveTo(Round((P1.X+Origin.X)*XScale),Round((P1.Y+Origin.Y)*YScale));
        LineTo(Round((P2.X+Origin.X)*XScale),Round((P2.Y+Origin.Y)*YScale));
      end;
    end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Lines:=TList.Create;
  Image1.Width:=PicWidth;
  Image1.Height:=PicHeight;
  Origin.X:=0;
  Origin.Y:=0;
  XStep:=40;
  YStep:=30;
  XScale:=1;
  YScale:=1;
  XScaleSB.Min:=1;
  YScaleSB.Min:=1;
  XScaleSB.Position:=10;
  YScaleSB.Position:=10;
  MoveState:=msNone;
  DrawCoord;
end;procedure TForm1.XScaleSBChange(Sender: TObject);
begin
  XScale:=XScaleSB.Position/10;
  DrawCoord;
  DrawLines;
end;procedure TForm1.YScaleSBChange(Sender: TObject);
begin
  YScale:=YScaleSB.Position/10;
  DrawCoord;
  DrawLines;  
end;procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pLine:TPLine;
begin
  LastPos.X:=X;
  LastPos.Y:=Y;
  if (mbRight in [Button]) and (MoveState<>msDrawLine) then
    MoveState:=msMoveOrigin
  else
    if (mbLeft in [Button]) and (MoveState<>msMoveOrigin) then
    begin
      GetMem(pLine,SizeOf(TLine));
      Lines.Add(pLine);
      pLine^.P1.X:=X;
      pLine^.P1.Y:=Y;
      MapPoint(pLine^.P1);
      pLine^.P2:=pLine^.P1;
      MoveState:=msDrawLine;
    end;end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  case MoveState of
    msMoveOrigin:
    begin
      Origin.X:=Origin.X+(X-LastPos.X)/XScale;
      Origin.Y:=Origin.Y+(Y-LastPos.Y)/YScale;
      LastPos.X:=X;
      LastPos.Y:=Y;
      DrawCoord;
      DrawLines;
    end;
    msDrawLine:
    begin
      with TPLine(Lines.Items[Lines.Count-1])^ do
      begin
        P2.X:=X;
        P2.Y:=Y;
        MapPoint(P2);
      end;
      DrawCoord;
      DrawLines;
    end;
  end;
end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MoveState:=msNone;
end;procedure TForm1.FormDestroy(Sender: TObject);
var
  i:Integer;
begin
  for i:=0 to Lines.Count-1 do
  begin
    FreeMem(Lines.Items[i]);
  end;
  Lines.Free;
end;
procedure TForm1.ExitBtnClick(Sender: TObject);
begin
  Close;
end;procedure TForm1.MapPoint(var Point: TFPoint);
begin
  Point.X:=(Point.X-Origin.X)/XScale;
  Point.Y:=(Point.Y-Origin.Y)/YScale;
end;end.