文档章节

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

涂孟超
 涂孟超
发布于 2014/09/26 15:35
字数 652
阅读 8
收藏 0
点赞 0
评论 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
深圳
程序员
OpenGL超级宝典笔记——画三角形

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

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

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

学术研究软件
2016/11/17
29
0
判断区域B是否在区域A内部的快速算法

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

最美的回忆
2017/07/19
0
0
OpenGL超级宝典笔记——其他图元

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

Mario_Q
2013/09/15
0
0
计算几何之三角剖分--Art Gallery Problem

Art Gallery Problem 我们先引入一个著名的Art Gallery问题: 对于一个多边形的画廊,需要多少个摄像头(360度无死角)才能完全覆盖? 圆点为摄像头。其实就转化为了这样一个问题: 作为一名...

superPershing
2017/03/26
0
0
判断点是否在多边形内部(Ray-casting Algorithm)

判断一个点是否在多边形内部的典型方法: (1)面积和判别法:判断目标点与多边形的每条边组成的三角形面积和是否等于该多边形,相等则在多边形内部。 (2)夹角和判别法:判断目标点与所有边...

vocaloid01
04/19
0
0
常见凸多边形判断方法

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

长平狐
2013/12/25
282
0
c++教程(二十一: Polymorphism)

在深入这一章之前,你应该对指针和类继承有一个正确的理解。如果您不确定下列表达式中的任何一个含义,则应查看所指示的部分: Pointers to base class 类继承的一个重要特征是指向派生类的指...

on2way
2017/02/07
0
0
GIS软件中的交互式绘图设计与实现

一、概述 交互式绘图,我的理解就是用鼠标去进行图形绘制。 在GIS软件开发与设计中,经常会用到交互式绘图,例如ARCGIS等软件都有非常复杂的人机交互功能。交互式绘图在GIS可以说占据比较重要...

长平狐
2013/12/25
83
0
点与多边形关系(改进射线法)

在GIS软件开发中,经常要用到一些几何的算法,比如三角网构建,多边形的剖分,点,线,面之间的关系。而点与多边形关系的判断是一项非常重要的基础工作。 在点与多边形关系的判断中,经常用到...

长平狐
2013/12/25
633
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

idea tomcat 远程调试

tomcat 配置 编辑文件${tomcat_home}/bin/catalina.sh,在文件开头添加如下代码。    CATALINA_OPTS="-Xdebug -Xrunjdwp:transport=dt_socket,server=y,suspend=n,address=7829" Idea端配......

qwfys
51分钟前
0
0
遍历目录下的文件每250M打包一个文件

#!/usr/bin/env python # -*- utf-8 -*- # @Time : 2018/7/20 0020 下午 10:16 # @Author : 陈元 # @Email : abcmeabc@163.com # @file : tarFile.py import os import tarfile import thr......

寻爱的小草
53分钟前
0
0
expect同步文件&expect指定host和要同步的文件&构建文件分发系统&批量远程执行命令

20.31 expect脚本同步文件 expect通过与rsync结合,可以在一台机器上把文件自动同步到多台机器上 编写脚本 [root@linux-5 ~]# cd /usr/local/sbin[root@linux-5 sbin]# vim 4.expect#!/...

影夜Linux
今天
0
0
SpringBoot | 第九章:Mybatis-plus的集成和使用

前言 本章节开始介绍数据访问方面的相关知识点。对于后端开发者而言,和数据库打交道是每天都在进行的,所以一个好用的ORM框架是很有必要的。目前,绝大部分公司都选择MyBatis框架作为底层数...

oKong
今天
10
0
win10 上安装解压版mysql

1.效果 2. 下载MySQL 压缩版 下载地址: https://downloads.mysql.com/archives/community/ 3. 配置 3.1 将下载的文件解压到合适的位置 我最终将myql文件 放在:D:\develop\mysql 最终放的位...

Lucky_Me
今天
1
0
linux服务器修改mtu值优化cpu

一、jumbo frames 相关 1、什么是jumbo frames Jumbo frames 是指比标准Ethernet Frames长的frame,即比1518/1522 bit大的frames,Jumbo frame的大小是每个设备厂商规定的,不属于IEEE标准;...

问题终结者
今天
1
0
expect脚本同步文件expect脚本指定host和要同步的文件 构建文件分发系统批量远程执行命令

expect脚本同步文件 在一台机器上把文件同步到多台机器上 自动同步文件 vim 4.expect [root@yong-01 sbin]# vim 4.expect#!/usr/bin/expectset passwd "20655739"spawn rsync -av ro...

lyy549745
今天
1
0
36.rsync下 日志 screen

10.32/10.33 rsync通过服务同步 10.34 linux系统日志 10.35 screen工具 10.32/10.33 rsync通过服务同步: rsync还可以通过服务的方式同步。那需要开启一个服务,他的架构是cs架构,客户端服务...

王鑫linux
今天
0
0
matplotlib 保存图片时的参数

简单绘图 import matplotlib.pyplot as pltplt.plot(range(10)) 保存为csv格式,放大后依然很清晰 plt.savefig('t1.svg') 普通保存放大后会有点模糊文件大小20多k plt.savefig('t5.p...

阿豪boy
今天
2
0
java 8 复合Lambda 表达式

comparator 比较器复合 //排序Comparator.comparing(Apple::getWeight);List<Apple> list = Stream.of(new Apple(1, "a"), new Apple(2, "b"), new Apple(3, "c")) .collect(......

Canaan_
昨天
0
0

没有更多内容

加载失败,请刷新页面

加载更多

下一页

返回顶部
顶部