Graphic control物件畫line有盲點 |
|
缺席
|
|
chiehjj
初階會員   發表：21 回覆：63 積分：26 註冊：2002-12-31 發送簡訊給我 |
前輩:
我做了一個元件,繼承自TGraphiccontrol,用該物件畫line,一般均正常,只有在Line寬度為1,座標位於(2,2),(4098,40)至(2,2),(2,4135)畫出的圖形有異常(不見line),不知何故?想請各位前輩幫忙看看,謝謝
測試程式如下
procedure TForm11.Button6Click(Sender: TObject);
begin
pureline1.Width :=4200;
pureline1.Height:=4200;
pureline1.X1 :=2;
pureline1.Y1 :=2;
pureline1.X2:=41;
pureline1.Y2:=4100;
end; procedure TForm11.Button12Click(Sender: TObject);
begin
pureline1.x2:=pureline1.x2 1;
button12.Caption :='x2=' inttostrpureline1.x2 );
end;
procedure TForm11.Button14Click(Sender: TObject);
begin
pureline1.x2:=pureline1.x2-1;
button14.Caption :='x2=' inttostrpureline1.x2 ); end; line元件程式如下 unit pureline; interface uses
SysUtils, Classes, Controls; type
Tpureline = class(TGraphicControl)
private
Fx1,Fx2,Fy1,Fy2:integer;
procedure setX1(value:integer);
procedure SetY1(value:integer);
procedure setX2(value:integer);
procedure SetY2(value:integer);
protected
procedure paint;override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property X1:integer read FX1 write SetX1 default 0;
property Y1:integer read FY1 write SetY1 default 0;
property X2:integer read FX2 write SetX2 default 0;
property Y2:integer read FY2 write SetY2 default 0;
end; procedure Register; implementation procedure Register;
begin
RegisterComponents('System', [Tpureline]);
end;
constructor TPUREline.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fx1:=0;fy1:=0;
fx2:=50; fy2:=50;
END;
destructor TPUREline.Destroy;
begin
inherited Destroy;
end;
procedure TPUREline.SetX1(value:integer);
begin
if value<>FX1 then
begin
FX1:=value;
invalidate;
end;
end;
procedure TPUREline.SetY1(value:integer);
begin
if value<>FY1 then
begin
FY1:=value;
invalidate;
end;
end;
procedure TPUREline.SetX2(value:integer);
begin
if value<>FX2 then
begin
FX2:=value;
invalidate;
end;
end;
procedure TPUREline.SetY2(value:integer);
begin
if value<>FY2 then
begin
FY2:=value;
invalidate;
end;
end;
Procedure Tpureline.Paint;
begin
inherited;
with Canvas do
begin
//font.Size :=5;
pen.Width :=1;//寬度設為2就會正常顯示
moveto(fx1,fy1);
lineto(fx2,fy2);
end;
end;
end.
|
發表時間：2005-05-30 10:17:56
IP:219.80.xxx.xxx 未訂閱
系統時間：2024-05-14 15:27:32
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |