随笔 - 2146  文章 - 19 评论 - 11846 阅读 - 1267万

本例效果图:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var f: Boolean = False;

procedure TForm1.FormClick(Sender: TObject);
const
  n = 50;
var
  ps: array[0..6] of TPoint;
  ns: array[0..1] of Integer;
  Rgn: HRGN;
  i: Integer;
begin
  Refresh;
  ps[0] := Point(n, n div 2);
  ps[1] := Point(n, ClientHeight - n);
  ps[2] := Point(ClientWidth - n, ClientHeight - n);
  ps[3] := Point(ClientWidth - n, n div 2);

  ps[4] := Point(ClientWidth div 2, n);
  ps[5] := Point(n div 2, ClientHeight - n div 2);
  ps[6] := Point(ClientWidth - n div 2, ClientHeight - n div 2);

  ns[0] := 4;
  ns[1] := 3;

  {建立多个多边形构成的区域}
  if f then
  begin
    Rgn := CreatePolyPolygonRgn(ps, ns, Length(ns), WINDING);
    Text := '填充模式: WINDING';
  end else begin
    Rgn := CreatePolyPolygonRgn(ps, ns, Length(ns), ALTERNATE);
    Text := '填充模式: ALTERNATE';
  end;
  f := not f;

  {填充区域}
  Canvas.Brush.Color := clSilver;
  Canvas.Brush.Style := bsCross;
  FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);

  {绘制区域边界}
  Canvas.Brush.Color := clRed;
  Canvas.Brush.Style := bsSolid;
  FrameRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle, 2, 2);

  Canvas.Brush.Color := Self.Color;
  for i := 0 to Length(ps) do
    Canvas.TextOut(ps[i].X, ps[i].Y, IntToStr(i));

  DeleteObject(Rgn);
end;

end.


下面的 "老A123" 需要使用动态数组, 可以改成这样:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var f: Boolean = False;

procedure TForm1.FormClick(Sender: TObject);
const
  n = 50;
var
  ps: array of TPoint;
  ns: array of Integer;
  Rgn: HRGN;
  i: Integer;
begin
  SetLength(ps, 7);
  SetLength(ns, 2);
  Refresh;
  ps[0] := Point(n, n div 2);
  ps[1] := Point(n, ClientHeight - n);
  ps[2] := Point(ClientWidth - n, ClientHeight - n);
  ps[3] := Point(ClientWidth - n, n div 2);

  ps[4] := Point(ClientWidth div 2, n);
  ps[5] := Point(n div 2, ClientHeight - n div 2);
  ps[6] := Point(ClientWidth - n div 2, ClientHeight - n div 2);

  ns[0] := 4;
  ns[1] := 3;

  {建立多个多边形构成的区域}
  if f then
  begin
    Rgn := CreatePolyPolygonRgn(ps[0], ns[0], Length(ns), WINDING);
    Text := '填充模式: WINDING';
  end else begin
    Rgn := CreatePolyPolygonRgn(ps[0], ns[0], Length(ns), ALTERNATE);
    Text := '填充模式: ALTERNATE';
  end;
  f := not f;

  {填充区域}
  Canvas.Brush.Color := clSilver;
  Canvas.Brush.Style := bsCross;
  FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);

  {绘制区域边界}
  Canvas.Brush.Color := clRed;
  Canvas.Brush.Style := bsSolid;
  FrameRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle, 2, 2);

  Canvas.Brush.Color := Self.Color;
  for i := 0 to Length(ps) do
    Canvas.TextOut(ps[i].X, ps[i].Y, IntToStr(i));

  DeleteObject(Rgn);
end;

end.

posted on   万一  阅读(8205)  评论(22编辑  收藏  举报
编辑推荐:
· 开发者必知的日志记录最佳实践
· SQL Server 2025 AI相关能力初探
· Linux系列:如何用 C#调用 C方法造成内存泄露
· AI与.NET技术实操系列(二):开始使用ML.NET
· 记一次.NET内存居高不下排查解决与启示
阅读排行:
· 阿里最新开源QwQ-32B,效果媲美deepseek-r1满血版,部署成本又又又降低了!
· 开源Multi-agent AI智能体框架aevatar.ai,欢迎大家贡献代码
· Manus重磅发布:全球首款通用AI代理技术深度解析与实战指南
· 被坑几百块钱后,我竟然真的恢复了删除的微信聊天记录!
· 没有Manus邀请码?试试免邀请码的MGX或者开源的OpenManus吧


点击右上角即可分享
微信分享提示