請問Delphi裏有沒有直接劃綫的工具? |
尚未結案
|
oktony
中階會員 發表:67 回覆:132 積分:64 註冊:2004-12-05 發送簡訊給我 |
|
jimmy_wei
高階會員 發表:9 回覆:176 積分:147 註冊:2003-08-28 發送簡訊給我 |
|
oktony
中階會員 發表:67 回覆:132 積分:64 註冊:2004-12-05 發送簡訊給我 |
|
StrongLemon
高階會員 發表:10 回覆:166 積分:105 註冊:2004-04-18 發送簡訊給我 |
您好:我寫了個範例,請參考
http://delphi.ktop.com.tw/topic.php?TOPIC_ID=67599 沒有元件?
最快的方式當然是找Google大神。
還是沒有??
那就自己寫囉~
|
jimmy_wei
高階會員 發表:9 回覆:176 積分:147 註冊:2003-08-28 發送簡訊給我 |
那如果是這樣會不會好一點??
你可以放一個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; |
oktony
中階會員 發表:67 回覆:132 積分:64 註冊:2004-12-05 發送簡訊給我 |
|
jest0024
高階會員 發表:11 回覆:310 積分:224 註冊:2002-11-24 發送簡訊給我 |
何不自己寫個元件好了!!~
繼承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 |
StrongLemon
高階會員 發表:10 回覆:166 積分:105 註冊:2004-04-18 發送簡訊給我 |
我直接把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 |
oktony
中階會員 發表:67 回覆:132 積分:64 註冊:2004-12-05 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |