我現在用的划綫方法是放一个shape然后把高度或者宽度设为0，感觉这样好麻烦，但又不想用寫代碼的方式，難道沒有直接劃橫綫或斜綫的工具嗎？

你說的寫代碼是這樣嗎?? Canvas.MoveTo(10, 10); Canvas.LineTo(100, 100);

是的，但有沒有直接在form上面划綫的控件？

您好：我寫了個範例，請參考 http://delphi.ktop.com.tw/topic.php?TOPIC_ID=67599 沒有元件？ 最快的方式當然是找Google大神。 還是沒有?? 那就自己寫囉～

那如果是這樣會不會好一點?? 你可以放一個IMAGEBUTTON,放隻筆的圖案,如果按下去就讓 以下的碼可執行,否則就是一般的滑鼠狀態這樣行不行??    

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Canvas.MoveTo(X, Y);
end;    procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Canvas.LineTo(X, Y);
end;

謝謝jimmy_wei，但是我要的是在設計時在form上直接畫綫。StrongLemon您能把您寫的程式發到我的email嗎？不知道爲什麽ktop上的程式我都下載不了，以前還可以的。

何不自己寫個元件好了!!~ 繼承TGraphicControl，改寫~

unit LineObj;    interface    uses
  SysUtils, Classes, Controls,Graphics;    type
  TLineObj = class(TGraphicControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    procedure Paint;override;
  published
    property Color;
  end;    procedure Register;    implementation    procedure Register;
begin
  RegisterComponents('Samples', [TLineObj]);
end;    procedure TLineObj.Paint;
begin
  Canvas.Pen.Color:=Color;
  Canvas.MoveTo(0,0);
  Canvas.LineTo(0,Height-1);
  //自己再增加其他繪圖方式!!
end;    end.

發表人 - jest0024 於 2005/03/24 23:03:33

我直接把Code貼上來好了，免得寄又寄不到..    還有不完全的地方，就給你改囉～順便練練功～ 1.線的顏色Color跟筆刷Brush，粗細Width 2.一條線是要連結一個Control元件？還是就共用DrawLine元件所連結的元件？ 3.視窗重繪時要能夠接受Msg處理重繪。 4.不止只能夠畫線，還能夠畫其他多種圖形。    

 
///////////////////這是元件部分//////////////////    unit UDrawLine;    interface    uses
   Classes,Controls,SysUtils;    type
   TDrawLine=class;
   TLines=class;
   TLine=class;
   TAccessCustomControl=class(TCustomControl)
   end;
   TLineClass=class of TLine;       TDrawLine=class(TComponent)
   private
     FLines:TLines;
     FLinkControl:TCustomControl;
     procedure SetLines(Value: TLines);
     function  CreateLine:TLine;
     function  CreateLines:TLines;
   protected
     function GetLineClass: TLineClass; virtual;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure DrawLines;
   published
     property Lines:TLines read FLines write SetLines;
     property LinkControl:TCustomControl read FLinkControl write FLinkControl;
   end;       TLines = class(TCollection)
    private
      FDrawLine: TDrawLine;
      function GetItem(Index: Integer): TLine;
      procedure SetItem(Index: Integer; Value: TLine);
    protected
      function GetOwner: TPersistent; override;
    public
      constructor Create(ADrawLine: TDrawLine);
      function Add: TLine;
      function AddItem(Item: TLine; Index: Integer): TLine;
      function Insert(Index: Integer): TLine;
      property Items[Index: Integer]: TLine read GetItem write SetItem; default;
    end;       TLine = class(TCollectionItem)
   private
     FFromX:Integer;
     FFromY:Integer;
     FToX:Integer;
     FToY:Integer;
   protected       public
     constructor Create(Collection: TCollection); override;  
   published
     property FromX:Integer read FFromX write FFromX;
     property FromY:Integer read FFromY write FFromY;
     property ToX:Integer read FToX write FToX;
     property ToY:Integer read FToY write FToY;       end;    procedure Register;    implementation    { TLine }    constructor TLine.Create(Collection: TCollection);
begin
  inherited Create(Collection);    end;    { TLines }    function TLines.Add: TLine;
begin
  Result := TLine(inherited Add);
end;    function TLines.AddItem(Item: TLine; Index: Integer): TLine;
begin
  if Item = nil then
    Result := FDrawLine.CreateLine
  else
    Result := Item;
  if Assigned(Result) then
  begin
    Result.Collection := Self;
    if Index < 0 then
      Index := Count - 1;
    Result.Index := Index;
  end;
end;    constructor TLines.Create(ADrawLine: TDrawLine);
begin
  if FDrawLine <> nil then
    inherited Create(FDrawLine.GetLineClass)
  else
    inherited Create(TLine);
  FDrawLine := ADrawLine;
end;    function TLines.GetItem(Index: Integer): TLine;
begin
  Result := TLine(inherited GetItem(Index));
end;    function TLines.GetOwner: TPersistent;
begin
  Result:=FDrawLine;
end;    function TLines.Insert(Index: Integer): TLine;
begin
  Result := AddItem(nil, Index);
end;    procedure TLines.SetItem(Index: Integer; Value: TLine);
begin
  inherited SetItem(Index, Value);
end;    { TDrawLine }    constructor TDrawLine.Create(AOwner: TComponent);
begin
  inherited;
  FLines := CreateLines;
end;    function TDrawLine.CreateLine: TLine;
begin
  Result:=TLine.Create(Lines);
end;    function TDrawLine.CreateLines:TLines;
begin
  Result:=TLines.Create(Self);
end;    destructor TDrawLine.Destroy;
begin
  FreeAndNil(FLines);
  inherited;
end;    procedure TDrawLine.DrawLines;
var
  I:Integer;
  tmpobj_Line:TLine;
begin
  if Assigned(FLinkControl) then
  begin
    for I:=0 to FLines.Count-1 do
    begin
      tmpobj_Line:=FLines.Items[I];
      with TAccessCustomControl(FLinkControl) do
      begin
        Canvas.MoveTo(tmpobj_Line.FFromX,tmpobj_Line.FFromY);
        Canvas.LineTo(tmpobj_Line.FToX,tmpobj_Line.FToY);
      end;
    end;
  end;
end;    function TDrawLine.GetLineClass: TLineClass;
begin
  Result := TLine;
end;    procedure TDrawLine.SetLines(Value: TLines);
begin
  FLines.Assign(Value);
end;    procedure Register;
begin
  RegisterComponents('Samples', [TDrawLine]);
end;    end.     
////////////////手工Code測試////////////////////////
unit Unit1;    interface    uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,UDrawLine, ExtCtrls;    type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Button3: TButton;
    DrawLine1: TDrawLine;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    FDrawLine:TDrawLine;
  public
    { Public declarations }
  end;    var
  Form1: TForm1;    implementation    {$R *.dfm}    procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.Canvas.MoveTo(0,0);
  Form1.Canvas.LineTo(100,100);
end;    procedure TForm1.Button2Click(Sender: TObject);
begin
  FDrawLine.LinkControl:=Panel1;
  with FDrawLine.Lines.Add do
  begin
    FromX:=0;
    FromY:=0;
    ToX:=100;
    ToY:=100;
  end;
end;    procedure TForm1.FormCreate(Sender: TObject);
begin
  FDrawLine:=TDrawLine.Create(Self);
end;    procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FDrawLine) then
    FreeAndNil(FDrawLine);
end;    procedure TForm1.Button3Click(Sender: TObject);
begin
  FDrawLine.DrawLines;
end;    end.    

發表人 - StrongLemon 於 2005/03/25 03:13:46

謝啦收下了！