文档章节

一个可以显示多边形的 TMyShape 类 - 回复 "董勇" 的问题

涂孟超
 涂孟超
发布于 2014/09/26 15:35
字数 652
阅读 8
收藏 0
测试效果图:



自定义的 MyShape 单元:
unit MyShape;

interface

uses
  Windows, Classes, Graphics, Controls;

type
  TMyShapeType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
    stEllipse, stCircle, stPolygon);

  TPoints = array of TPoint;

  TMyShape = class(TGraphicControl) {根据 TShape 改写}
  private
    FPen: TPen;
    FBrush: TBrush;
    FShape: TMyShapeType;
    FPonits: TPoints;
    procedure SetBrush(Value: TBrush);
    procedure SetPen(Value: TPen);
    procedure SetShape(Value: TMyShapeType);
    procedure SetPonits(const Value: TPoints);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    procedure StyleChanged(Sender: TObject);
    property Align;
    property Anchors;
    property Brush: TBrush read FBrush write SetBrush;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Constraints;
    property ParentShowHint;
    property Pen: TPen read FPen write SetPen;
    property Shape: TMyShapeType read FShape write SetShape default stRectangle;
    property ShowHint;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property Ponits: TPoints read FPonits write SetPonits;
  end;

implementation

{ MyTShape }

constructor TMyShape.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 65;
  Height := 65;
  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
end;

destructor TMyShape.Destroy;
begin
  FPen.Free;
  FBrush.Free;
  inherited Destroy;
end;

procedure TMyShape.Paint;
var
  X, Y, W, H, S: Integer;
begin
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
    X := Pen.Width div 2;
    Y := X;
    W := Width - Pen.Width + 1;
    H := Height - Pen.Width + 1;
    if Pen.Width = 0 then
    begin
      Dec(W);
      Dec(H);
    end;
    if W < H then S := W else S := H;
    if FShape in [stSquare, stRoundSquare, stCircle] then
    begin
      Inc(X, (W - S) div 2);
      Inc(Y, (H - S) div 2);
      W := S;
      H := S;
    end;
    case FShape of
      stRectangle, stSquare:
        Rectangle(X, Y, X + W, Y + H);
      stRoundRect, stRoundSquare:
        RoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
      stCircle, stEllipse:
        Ellipse(X, Y, X + W, Y + H);
      stPolygon:
        Polygon(FPonits);
    end;
  end;
end;

procedure TMyShape.StyleChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TMyShape.SetBrush(Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TMyShape.SetPen(Value: TPen);
begin
  FPen.Assign(Value);
end;

procedure TMyShape.SetShape(Value: TMyShapeType);
begin
  if FShape <> Value then
  begin
    FShape := Value;
    Invalidate;
  end;
end;

procedure TMyShape.SetPonits(const Value: TPoints);
var
  i,x,y: Integer;
begin
  FPonits := Value;
  for i := 0 to Length(Value) - 1 do
  begin
    x := Value[i].X;
    y := value[i].Y;
    if Left > x then Left := x;
    if Top > y then Top := y;
    if Width < x then Width := x;
    if Height < y then Height := y;
  end;
  Invalidate;
end;

end.

 
 
 
 
 

 

 

  

测试代码:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses MyShape;

var
  shape: TMyShape;

procedure TForm1.Button1Click(Sender: TObject);
var
  pts: TPoints;
  i: Integer;
begin
  Randomize;
  SetLength(pts, Random(4)+3); {随机测试: 最少是三角形、最多是七边形}
  for i := 0 to Length(pts) - 1 do
  begin
    pts[i].X := Random(ClientWidth);
    pts[i].Y := Random(ClientHeight);
  end;
  shape.Ponits := pts;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  pts: TPoints;
begin
  shape := TMyShape.Create(Self);

  SetLength(pts, 4);
  pts[0] := Point(ClientWidth div 2, 10);
  pts[1] := Point(ClientWidth - 10, ClientHeight div 2);
  pts[2] := Point(ClientWidth div 2, ClientHeight - 10);
  pts[3] := Point(10, ClientHeight div 2);

  shape.Ponits := pts;
  shape.Shape := stPolygon;
  shape.Parent := Self;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  shape.Free;
end;

end.

 
 
 
 
 

 

 

  
测试窗体:
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 206
  ClientWidth = 339
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 256
    Top = 160
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
end

 
 
 
 
 

 

 

  

本文转载自:http://www.cnblogs.com/del/archive/2008/11/18/1335820.html

共有 人打赏支持
涂孟超
粉丝 12
博文 2011
码字总数 14107
作品 0
深圳
程序员
私信 提问
判断区域B是否在区域A内部的快速算法

在图像分析中,经常需要判断图像分割所得到的区域之间的关系。通常情况,我们通过八邻接外轮廓(准确说法是扩展边缘,但这样又得费半天口舌解释什么是扩展边缘)来描述一个区域并对区域进行标...

最美的回忆
2017/07/19
0
0
OpenGL超级宝典笔记——画三角形

学习了画线的知识,我们可以使用GLLINELOOP来画闭合的多边形。但是使用这种方式画出来的只有线框,多边形没有填充颜色。OpenGL支持绘制实心的多边形,并使用当前的颜色进行填充。 三角形 简单...

Mario_Q
2013/09/12
0
0
怎么用几何画板演示多边形滚动动画

如果我们生活中的车轮不是圆形的,而是正方形,那么我们应该修什么样的路,这样才能够使有正方形车轮的车辆如履平地?这是数学中的一个思维扩散题,其实不仅仅是正方形,还可以想象成是任意多...

学术研究软件
2016/11/17
29
0
常见凸多边形判断方法

凸多边形的判定方法 在计算几何和地理信息系统中,多边形的凹凸性判定十分重要。那么什么是凹多边形和凸多边形呢?首先,我们从直观上来理解,凸多边形就是多边形任意两个顶点的连线在多边形...

长平狐
2013/12/25
282
0
OpenGL超级宝典笔记——其他图元

四边形 OpenGL的GLQUADS图元,可以指定4个点画出四边形。这些多边形具有顺时针环绕的方向。PS:四边形的四个角必须位于同一个平面 GLQUADSSTRIP图元可以画四边形带。 通用多边形 GLPOLYGONS...

Mario_Q
2013/09/15
0
0

没有更多内容

加载失败,请刷新页面

加载更多

java8之stream流的基本操作

一、stream流简介 Stream流是数据渠道,用于操作数据源(集合、数组等)所生成的元素序列。 Stream的优点:声明性,可复合,可并行。这三个特性使得stream操作更简洁,更灵活,更高效。 Stre...

嘴角轻扬30
25分钟前
1
0
Docker 可视化管理工具 Panama

Panamax 是一个开源的项目,可以通过简单的拖拉操作就可以实现发布复杂的 Docker 容器应用。Panamax 为 Docker, Fleet & CoreOS 提供友好的管理界面。 容器技术是下一代的虚拟机,但使用该技...

linuxprobe16
26分钟前
2
0
scala中hdfs文件的操作

对于org.apache.hadoop.fs.Path来说, path.getName只是文件名,不包括路径 path.getParent也只是父文件的文件名,同样不包括路径 path.toString才是文件的全路径名 创建文件 hdfs.createNew...

hblt-j
41分钟前
2
0
Eureka 和 zookeeper 的比较

小小小施爷
50分钟前
0
0
c++ 开源算法库 (持续更新)

最近在做算法方面的研究,发现很难找到一个全面而优质的科学计算算法库。不过还是找到一些,在此记录一下,将来也许自己写一个把所有这些整合在一起。本列表会持续不定期更新。 GSL http://w...

propagator
今天
6
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部