📄 drwobj.~pas
字号:
function TDrawEllipse.getMinPoint: TPoint;
begin
result:=Point(m_x1,m_y1);
end;
procedure TDrawEllipse.HotPoints(drwCanvas: TCanvas);
begin
HotPoint(drwcanvas,round(m_x1*fZoomScale),round(m_y1*fZoomScale));
HotPoint(drwCanvas,round(m_x2*fZoomScale),round(m_y2*fZoomScale));
HotPoint(drwCanvas,round(m_x1*fZoomScale),round(m_y2*fZoomScale));
HotPoint(drwCanvas,round(m_x2*fZoomScale),round(m_y1*fZoomScale));
end;
function TDrawEllipse.IsValid: boolean;
var
t1,t2:TPoint;
begin
t1:=Point(m_x1,m_y1);
t2:=Point(m_x2,m_y1);
isValid:=not IsEqual(t1,t2);
end;
procedure TDrawEllipse.Load(stream: TStream);
begin
inherited;
stream.Read(FBrushColor,sizeOf(TColor));
stream.Read(FBrushStyle,sizeOf(TBrushStyle));
stream.Read(m_x1,sizeOf(longint));
stream.Read(m_y1,sizeOf(longint));
stream.Read(m_x2,sizeOf(longint));
stream.Read(m_y2,sizeOf(longint));
end;
procedure TDrawEllipse.MoveAt(drwCanvas: TCanvas; flags, x, y: Integer);
var
oldPenColor:TColor;
oldPenWidth:integer;
oldBrushStyle:TBrushStyle;
oldPenStyle:TPenStyle;
oldPenMode:TPenMode;
begin
if not Assigned(self) then exit;
{如果原先设置的热点,则取消}
if mSelected then
HotPoints(drwCanvas);
{保存画布的原先设置}
oldPenColor:=drwCanvas.Pen.Color;
oldBrushStyle:=drwCanvas.Brush.Style;
oldPenWidth:=drwCanvas.Pen.Width;
oldPenMode:=drwCanvas.Pen.Mode;
oldPenStyle:=drwCanvas.Pen.Style;
{设置新的画笔和画刷的属性}
drwCanvas.Pen.Mode :=pmNotXor;
drwCanvas.Pen.Width :=1;
drwCanvas.Brush.Style :=bsClear;
drwCanvas.Pen.Color :=clBlack;
drwCanvas.Pen.Style :=getPenStyle;
{首先删除椭圆}
drwCanvas.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
{设置新的图形坐标}
if flags=1 then
begin
m_x1:=x;
m_y1:=y;
end
else if flags=2 then
begin
m_x1:=x;
m_y2:=y;
end
else if flags=3 then
begin
m_x2:=x;
m_y1:=y;
end
else if flags=4 then
begin
m_x2:=x;
m_y2:=y;
end
else if flags=-1 then
begin
m_x1:=m_x1+x-m_oldx;
m_y1:=m_y1+y-m_oldy;
m_x2:=m_x2+x-m_oldx;
m_y2:=m_y2+y-m_oldy;
m_oldx:=x;
m_oldy:=y;
end;
{绘制新图形}
drwCanvas.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
{恢复画布的原先设置}
drwCanvas.Pen.Color :=oldPenColor;
drwCanvas.Pen.Width :=oldPenWidth;
drwCanvas.Pen.Mode :=oldPenMode;
drwCanvas.Brush.Style :=oldBrushStyle;
drwCanvas.Pen.Style :=oldPenStyle;
{如果原先设置的热点,则取消}
if mSelected then
HotPoints(drwCanvas);
end;
function TDrawEllipse.NewPoint(x, y: Integer): integer;
begin
m_x1:=x;m_x2:=x;
m_y1:=y;m_y2:=y;
result:=4;
end;
procedure TDrawEllipse.Save(stream: TStream);
begin
inherited;
stream.Write(FBrushColor,sizeOf(TColor));
stream.Write(FBrushStyle,sizeOf(TBrushStyle));
stream.Write(m_x1,sizeOf(longint));
stream.Write(m_y1,sizeOf(longint));
stream.Write(m_x2,sizeOf(longint));
stream.Write(m_y2,sizeOf(longint));
end;
function TDrawEllipse.SelectAt(x, y: Integer): integer;
var
rgn:HRGN;
begin
result:=0;
rgn:=CreateEllipticRgn(m_x1,m_y1,m_x2,m_y2);
if atPoint(x,y,m_x1,m_y1) then
result:=1
else if atPoint(x,y,m_x1,m_y2) then
result:=2
else if atPoint(x,y,m_x2,m_y1) then
result:=3
else if atPoint(x,y,m_x2,m_y2) then
result:=4
else if atCurve(x,y) or PtInRegion(rgn,x,y) then
begin
m_oldx:=x;
m_oldy:=y;
result:=-1;
end;
DeleteObject(rgn);
end;
procedure TDrawEllipse.Selected(drwCanvas: TCanvas; select: boolean);
begin
inherited;
if not Assigned(self) then exit;
if select then
begin
if not mSelected then
begin
HotPoints(drwCanvas);
mSelected:=true;
end;
end
else
begin
if mSelected then
begin
HotPoints(drwCanvas);
mSelected:=false;
end;
end;
end;
procedure TDrawEllipse.setOrg;
begin
fRect:=Rect(m_x1,m_y1,m_x2,m_y2);
end;
{ TDrawCircle }
procedure TDrawCircle.addXY(x, y, flags: integer;zoomScaleX:real=1.0;zoomScaleY:real=1.0);
begin
if flags=-1 then
begin
m_x1:=round(m_x1*zoomScaleX+x);
m_y1:=round(m_y1*zoomScaleY+y);
m_x2:=round(m_x2*zoomScaleX+x);
m_y2:=round(m_y2*zoomScaleY+y);
end;
if flags<>-1 then
begin
m_x1:=round(fRect.Left*zoomScaleX);
m_y1:=round(fRect.Top*zoomScaleY);
m_x2:=round(fRect.Right*zoomScaleX);
m_y2:=round(fRect.Bottom*zoomScaleY);
end;
end;
constructor TDrawCircle.create;
begin
inherited;
FBrushStyle:=bsClear;
FBrushColor:=clSilver;
m_x1:=0;m_y1:=0;
m_x2:=0;m_y2:=0;
m_oldx:=0;m_oldy:=0;
end;
procedure TDrawCircle.Draw(drwCanvas: TCanvas);
var
oldPenColor,oldBrushColor:TColor;
oldPenWidth:integer;
oldBrushStyle:TBrushStyle;
oldPenStyle:TPenStyle;
oldPenMode:TPenMode;
t:TRect;
rgn:HRgn;
begin
if not Visible then exit;
{保存画布的原先设置}
oldPenColor:=drwCanvas.Pen.Color;
oldBrushColor:=drwCanvas.Brush.Color;
oldBrushStyle:=drwCanvas.Brush.Style;
oldPenWidth:=drwCanvas.Pen.Width;
oldPenMode:=drwCanvas.Pen.Mode;
oldPenStyle:=drwCanvas.Pen.Style;
{设置画布新的设置}
drwCanvas.Pen.Color:=GetPenColor;
drwCanvas.Brush.Color :=FBrushColor;
drwCanvas.Brush.Style :=FBrushStyle;
drwCanvas.Pen.Width :=GetPenWidth;
drwCanvas.Pen.Mode:=pmCopy;
drwCanvas.Pen.Style :=getPenStyle;
t.TopLeft:=Point(m_x1,m_y1);
t.BottomRight:=Point(m_x2,m_y2);
{进行方向正常化}
NormalRect(t);
m_x1:=t.Left;m_y1:=t.Top;
m_x2:=t.Right;m_y2:=t.Bottom;
//渐变填充 2004.4.9 add
t:=rect(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
if Gradient then
begin
drwcanvas.Brush.Style:=bsSolid;
rgn:=CreateEllipticRgn(t.Left,t.Top,t.Right,t.Bottom);
selectClipRgn(drwCanvas.Handle,rgn);
FillWithGradient(drwCanvas,BeginColor,EndColor,GradientStyle,t);
SelectClipRgn(drwCanvas.Handle,0);
DeleteObject(rgn);
drwCanvas.Brush.Style:=bsClear;
drwCanvas.Ellipse(t.Left,t.Top,t.Right,t.Bottom);
end
else
drwCanvas.Ellipse(round(m_x1*fZoomScale),round(m_y1*fZoomScale),round(m_x2*fZoomScale),round(m_y2*fZoomScale));
{恢复画布的设置}
drwCanvas.Pen.Color :=oldPenColor;
drwCanvas.Pen.Width :=oldPenWidth;
drwCanvas.Pen.Mode :=oldPenMode;
drwCanvas.Brush.Color :=oldBrushColor;
drwCanvas.Brush.Style :=oldBrushStyle;
drwCanvas.Pen.Style :=oldPenStyle;
if FSelected then
HotPoints(drwCanvas);
end;
function TDrawCircle.getMaxPoint: TPoint;
begin
result.X :=m_x2;
result.Y :=m_y2;
end;
function TDrawCircle.getMinPoint: TPoint;
begin
result.x:=m_x1;
result.y:=m_y1;
end;
procedure TDrawCircle.HotPoints(drwCanvas: TCanvas);
begin
HotPoint(drwcanvas,round(m_x1*fZoomScale),round(m_y1*fZoomScale));
HotPoint(drwCanvas,round(m_x2*fZoomScale),round(m_y2*fZoomScale));
HotPoint(drwCanvas,round(m_x1*fZoomScale),round(m_y2*fZoomScale));
HotPoint(drwCanvas,round(m_x2*fZoomScale),round(m_y1*fZoomScale));
end;
function TDrawCircle.IsValid: boolean;
var
t1,t2:TPoint;
begin
t1:=Point(m_x1,m_y1);
t2:=Point(m_x2,m_y1);
isValid:=not IsEqual(t1,t2);
end;
procedure TDrawCircle.Load(stream: TStream);
begin
inherited;
stream.Read(FBrushColor,sizeOf(TColor));
stream.Read(FBrushStyle,sizeOf(TBrushStyle));
stream.Read(m_x1,sizeOf(longint));
stream.Read(m_y1,sizeOf(longint));
stream.Read(m_x2,sizeOf(longint));
stream.Read(m_y2,sizeOf(longint));
end;
procedure TDrawCircle.MoveAt(drwCanvas: TCanvas; flags, x, y: Integer);
var
oldPenColor:TColor;
oldPenWidth:integer;
oldBrushStyle:TBrushStyle;
oldPenStyle:TPenStyle;
oldPenMode:TPenMode;
begin
if not Assigned(self) then exit;
{保存画布的原先设置}
oldPenColor:=drwCanvas.Pen.Color;
oldBrushStyle:=drwCanvas.Brush.Style;
oldPenWidth:=drwCanvas.Pen.Width;
oldPenMode:=drwCanvas.Pen.Mode;
oldPenStyle:=drwCanvas.Pen.Style;
{设置画布新的设置}
drwCanvas.Pen.Color:=clBlack;
drwCanvas.Brush.Style :=bsClear;
drwCanvas.Pen.Width :=1;
drwCanvas.Pen.Mode:=pmNotXor;
drwCanvas.Pen.Style :=getPenStyle;
{如果原先设置的热点,则取消}
if mSelected then
HotPoints(drwCanvas);
{首先删除椭圆}
drwCanvas.Ellipse(round((m_x1)*fZoomScale),round((m_y1)*fZoomScale),round((m_x2)*fZoomScale),round((m_y2)*fZoomScale));
{设置新的图形坐标}
if flags=1 then
begin
m_y1:=y;
m_x1:=m_x2-(m_y2-m_y1);
end
else if flags=2 then
begin
m_y2:=y;
m_x1:=m_x2-(m_y2-m_y1);
end
else if flags=3 then
begin
m_y1:=y;
m_x2:=m_x1+(m_y2-m_y1);
end
else if flags=4 then
begin
m_y2:=y;
m_x2:=m_x1+(m_y2-m_y1);
end
else if flags=-1 then
begin
m_x1:=m_x1+x-m_oldx;
m_y1:=m_y1+y-m_oldy;
m_x2:=m_x2+x-m_oldx;
m_y2:=m_y2+y-m_oldy;
m_oldx:=x;
m_oldy:=y;
end;
{绘制新图形}
drwCanvas.Ellipse(round((m_x1)*fZoomScale),round((m_y1)*fZoomScale),round((m_x2)*fZoomScale),round((m_y2)*fZoomScale));
{恢复画布的原先设置}
drwCanvas.Pen.Color :=oldPenColor;
drwCanvas.Pen.Width :=oldPenWidth;
drwCanvas.Pen.Mode :=oldPenMode;
drwCanvas.Brush.Style :=oldBrushStyle;
drwCanvas.Pen.Style :=oldPenStyle;
{如果原先设置的热点,则取消}
if mSelected then
HotPoints(drwCanvas);
end;
function TDrawCircle.NewPoint(x, y: Integer): integer;
begin
m_x1:=x;m_x2:=x;
m_y1:=y;m_y2:=y;
result:=4;
end;
procedure TDrawCircle.Save(stream: TStream);
begin
inherited;
stream.Write(FBrushColor,sizeOf(TColor));
stream.Write(FBrushStyle,sizeOf(TBrushStyle));
stream.Write(m_x1,sizeOf(longint));
stream.Write(m_y1,sizeOf(longint));
stream.Write(m_x2,sizeOf(longint));
stream.Write(m_y2,
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -