一种简单的图像分析

月巴月巴白勺合鸟月半2024-06-23 8:09

简介

一种简单的边界分析，通过相邻的像素的灰度进行判断，计算出边界。

测试1

原图

结果

测试2

原图

结果

代码说明

主要的技术在makeTable过程中，这个过程主要执行了以下几步

  1. 计算每个像素的灰度
  2. 计算相邻多个像素的最大灰度差
  3. 统计灰度差，计算出阈值
  4. 根据阈值，计算出边界，并标注在图像上

procedure makeTable(img: TBitmap32);

var

w, h, w_r, h_r, x, y, k, r_count, Pcount: Integer;

bmp2, bmp: TBitmap32;

blist: TByteTable;

blist_diff: TByteTable;

b, b1, b2, maxa: byte;

c32: TColor32Entry;

sum, stepCount, count: integer;

idx, i, j, s_x_1, s_x_2: integer;

s_y_1, s_y_2: integer;

c_b: array0..255 of integer;

FilterB: Byte;

Filter_Count: integer;

Filter_Sum: integer;

RectList: array of array of TRectRec;

r: Trect;

pt_1, path: array of TPoint;

fillcount, maxfillcount: integer;

function check_r(i, j: integer; pt: array of TPoint): Boolean;

var

idx: integer;

begin

Result := false;

if RectListi, j.count <= 0 then

exit;

for idx := 0 to high(pt) do

begin

if RectListi + pt\[idx.X, j + ptidx.y].count > 0 then

begin

Result := false;

Exit;

end;

end;

Result := true;

end;

procedure getFill(x, y: integer; pt: array of TPoint; MaxCount: integer; var path: array of TPoint; var count: integer);

var

idx: integer;

ax, ay: integer;

begin

if x < 0 then

Exit;

if y < 0 then

Exit;

if x >= w_r then

Exit;

if y >= h_r then

Exit;

if RectListx, y.count <= 0 then

Exit;

if count >= MaxCount then

exit;

for idx := count - 1 downto 0 do

begin

if (pathidx.X = x) and (pathidx.y = y) then

begin

Exit;

end;

end;

pathcount := Point(x, y);

inc(count);

if count >= MaxCount then

exit;

for idx := 0 to high(pt) do

begin

ax := x + ptidx.X;

ay := y + ptidx.Y;

getFill(ax, ay, pt, MaxCount, path, count);

end;

end;

begin

w := img.Width;

h := img.Height;

SetLength(blist, w);

for x := 0 to w - 1 do

SetLength(blistx, h);

SetLength(blist_diff, w);

for x := 0 to w - 1 do

SetLength(blist_diffx, h);

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

c32.ARGB := img.Pixelx, y;

b := (77 * c32.R + 150 * c32.G + 29 * c32.B) shr 8;

blistx, y := b;

end;

bmp2 := TBitmap32.Create;

bmp2.SetSize(w, h);

maxa := 0;

stepCount := 5;

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

count := min(x - 0 + 1, stepCount);

s_x_1 := getsum(blist, x, y, -1, 0, count);

count := min(w - x, stepCount);

s_x_2 := getsum(blist, x, y, 1, 0, count);

count := min(y - 0 + 1, stepCount);

s_y_1 := getsum(blist, x, y, 0, -1, count);

count := min(h - y, stepCount);

s_y_2 := getsum(blist, x, y, 0, 1, count);

b := max(abs(s_x_1 - s_x_2), abs(s_y_1 - s_y_2));

blist_diffx, y := b;

if b > maxa then

maxa := b;

end;

ZeroMemory(@(c_b0), length(c_b) * sizeof(i));

Pcount := 0;

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

b := blist_diffx, y;

b := 255 * b div maxa;

blist_diffx, y := b;

inc(c_bb);

inc(Pcount);

end;

FilterB := 0;

count := 0;

for i := 0 to 255 do

begin

inc(count, c_bi);

if count > (Pcount div 2) then

begin

FilterB := i ;

Break;

end

end;

Pcount := 0;

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

if blist_diffx, y < FilterB then

blist_diffx, y := 0;

end;

x := 0;

y := 0;

r_count := 10;

w_r := (w - 1) div r_count + 1;

h_r := (h - 1) div r_count + 1;

SetLength(RectList, w_r);

for x := 0 to w_r - 1 do

SetLength(RectListx, h_r);

for i := 0 to w_r - 1 do

for j := 0 to h_r - 1 do

begin

x := (i) * r_count;

y := (j) * r_count;

r.Left := x;

r.Top := y;

r.Right := Min(x + r_count, w);

r.Bottom := Min(y + r_count, h);

RectListi, j.rect := r;

RectListi, j.sum := 0;

RectListi, j.count := 0;

end;

count := 0;

sum := 0;

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

b := blist_diffx, y;

if b = 0 then

Continue;

i := x div (r_count);

j := y div (r_count);

inc(RectListi, j.sum, b);

inc(RectListi, j.count);

inc(sum, b);

inc(count);

end;

Filter_Sum := sum div count;

Filter_Count := max(r_count, count div (w_r * h_r));

setlength(pt_1, 8);

pt_10 := Point(-1, -1);

pt_11 := Point(0, -1);

pt_12 := Point(+1, -1);

pt_13 := Point(-1, 0);

pt_14 := Point(+1, 0);

pt_15 := Point(-1, +1);

pt_16 := Point(0, +1);

pt_17 := Point(-1, +1);

for i := 0 to w_r - 1 do

for j := 0 to h_r - 1 do

begin

if RectListi, j.count < Filter_Count then

begin

RectListi, j.count := 0

end

else

begin

if RectListi, j.sum < (Filter_Sum * RectListi, j.count) then

begin

RectListi, j.count := 0;

end;

end;

end;

setlength(path, 255);

maxfillcount := 50;

for i := 0 to w_r - 1 do

for j := 0 to h_r - 1 do

begin

fillcount := 0;

getFill(i, j, pt_1, maxfillcount + 1, path, fillcount);

if fillcount <= maxfillcount then

begin

for idx := 0 to fillcount - 1 do

begin

RectListpath\[idx.X, pathidx.y].count := 0;

end;

end;

end;

setlength(pt_1, 0);

setlength(path, 0);

Pcount := 0;

for x := 1 to w - 2 do

for y := 1 to h - 2 do

begin

if blist_diffx, y > 0 then

inc(Pcount);

end;

c32.ARGB := clRed32;

for x := 0 to w - 1 do

for y := 0 to h - 1 do

begin

i := x div (r_count);

j := y div (r_count);

if RectListi, j.count > 0 then

c32.A := blist_diffx, y

else

c32.A := 0;

bmp2.Pixelx, y := c32.ARGB;

end;

bmp2.DrawMode := dmBlend;

for i := 0 to w_r - 1 do

for j := 0 to h_r - 1 do

begin

if RectListi, j.count > 0 then

img.FrameRectS(RectListi, j.rect, clBlue32);

end;

img.Draw(0, 0, bmp2);

FreeAndNil(bmp2);

for x := 0 to w - 1 do

SetLength(blistx, 0);

SetLength(blist, 0);

for x := 0 to w - 1 do

SetLength(blist_diffx, 0);

SetLength(blist_diff, 0);

for x := 0 to w_r - 1 do

SetLength(RectListx, 0);

setlength(RectList, 0);

end;

完整代码

Delphi 复制代码 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Image1: TImage;
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses math;
type
  TByteTable = array of array of Byte;
  TRectRec = record
    rect: TRect;
    b: Byte;
    sum: integer;
    count: integer;
  end;

function getsum(table: TByteTable; ax, ay, ix, iy, count: integer): integer;
var
  i, x, y: integer;
begin
  Result := 0;
  x := ax;
  y := ay;
  for i := 1 to count do
    begin
      inc(Result, table[x, y]);
      inc(x, ix);
      inc(y, iy);
    end;
  Result := Result div count;
end;

procedure makeTable(img: TBitmap32);
var
  w, h, w_r, h_r, x, y, k, r_count, Pcount: Integer;
  bmp2, bmp: TBitmap32;
  blist: TByteTable;
  blist_diff: TByteTable;
  b, b1, b2, maxa: byte;
  c32: TColor32Entry;
  sum, stepCount, count: integer;
  idx, i, j, s_x_1, s_x_2: integer;
  s_y_1, s_y_2: integer;
  c_b: array[0..255] of integer;
  FilterB: Byte;
  Filter_Count: integer;
  Filter_Sum: integer;

  RectList: array of array of TRectRec;
  r: Trect;
  pt_1, path: array of TPoint;
  fillcount, maxfillcount: integer;
  function check_r(i, j: integer; pt: array of TPoint): Boolean;
  var
    idx: integer;
  begin
    Result := false;
    if RectList[i, j].count <= 0 then
      exit;

    for idx := 0 to high(pt) do
      begin
        if RectList[i + pt[idx].X, j + pt[idx].y].count > 0 then
          begin
            Result := false;
            Exit;
          end;
      end;
    Result := true;
  end;
  procedure getFill(x, y: integer; pt: array of TPoint; MaxCount: integer; var path: array of TPoint; var count: integer);
  var
    idx: integer;
    ax, ay: integer;
  begin
    if x < 0 then
      Exit;
    if y < 0 then
      Exit;
    if x >= w_r then
      Exit;
    if y >= h_r then
      Exit;
    if RectList[x, y].count <= 0 then
      Exit;
    if count >= MaxCount then
      exit;
    for idx := count - 1 downto 0 do
      begin
        if (path[idx].X = x) and (path[idx].y = y) then
          begin
            Exit;
          end;
      end;
    path[count] := Point(x, y);
    inc(count);
    if count >= MaxCount then
      exit;
    for idx := 0 to high(pt) do
      begin
        ax := x + pt[idx].X;
        ay := y + pt[idx].Y;
        getFill(ax, ay, pt, MaxCount, path, count);
      end;
  end;
begin
  w := img.Width;
  h := img.Height;

  SetLength(blist, w);
  for x := 0 to w - 1 do
    SetLength(blist[x], h);
  SetLength(blist_diff, w);
  for x := 0 to w - 1 do
    SetLength(blist_diff[x], h);

  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin
        c32.ARGB := img.Pixel[x, y];
        b := (77 * c32.R + 150 * c32.G + 29 * c32.B) shr 8;
        blist[x, y] := b;
      end;



  bmp2 := TBitmap32.Create;
  bmp2.SetSize(w, h);
  maxa := 0;
  stepCount := 5;
  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin
        count := min(x - 0 + 1, stepCount);
        s_x_1 := getsum(blist, x, y, -1, 0, count);
        count := min(w - x, stepCount);
        s_x_2 := getsum(blist, x, y, 1, 0, count);

        count := min(y - 0 + 1, stepCount);
        s_y_1 := getsum(blist, x, y, 0, -1, count);
        count := min(h - y, stepCount);
        s_y_2 := getsum(blist, x, y, 0, 1, count);

        b := max(abs(s_x_1 - s_x_2), abs(s_y_1 - s_y_2));
        blist_diff[x, y] := b;
        if b > maxa then
          maxa := b;
      end;

  ZeroMemory(@(c_b[0]), length(c_b) * sizeof(i));
  Pcount := 0;
  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin
        b := blist_diff[x, y];
        b := 255 * b div maxa;
        blist_diff[x, y] := b;
        inc(c_b[b]);
        inc(Pcount);
      end;
  FilterB := 0;
  count := 0;
  for i := 0 to 255 do
    begin
      inc(count, c_b[i]);
      if count > (Pcount div 2) then
        begin
          FilterB := i ;
          Break;
        end
    end;

  Pcount := 0;
  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin

        if blist_diff[x, y] < FilterB then
          blist_diff[x, y] := 0;
      end;
  x := 0;
  y := 0;
  r_count := 10;
  w_r := (w - 1) div r_count + 1;
  h_r := (h - 1) div r_count + 1;

  SetLength(RectList, w_r);
  for x := 0 to w_r - 1 do
    SetLength(RectList[x], h_r);

  for i := 0 to w_r - 1 do
    for j := 0 to h_r - 1 do
      begin
        x := (i) * r_count;
        y := (j) * r_count;
        r.Left := x;
        r.Top := y;
        r.Right := Min(x + r_count, w);
        r.Bottom := Min(y + r_count, h);
        RectList[i, j].rect := r;
        RectList[i, j].sum := 0;
        RectList[i, j].count := 0;
      end;
  count := 0;
  sum := 0;
  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin
        b := blist_diff[x, y];
        if b = 0 then
          Continue;
        i := x div (r_count);
        j := y div (r_count);
        inc(RectList[i, j].sum, b);
        inc(RectList[i, j].count);
        inc(sum, b);
        inc(count);
      end;

  Filter_Sum := sum div count;
  Filter_Count := max(r_count, count div (w_r * h_r));
  setlength(pt_1, 8);
  pt_1[0] := Point(-1, -1);
  pt_1[1] := Point(0, -1);
  pt_1[2] := Point(+1, -1);
  pt_1[3] := Point(-1, 0);
  pt_1[4] := Point(+1, 0);
  pt_1[5] := Point(-1, +1);
  pt_1[6] := Point(0, +1);
  pt_1[7] := Point(-1, +1);

  for i := 0 to w_r - 1 do
    for j := 0 to h_r - 1 do
      begin
        if RectList[i, j].count < Filter_Count then
          begin
            RectList[i, j].count := 0
          end
        else
          begin
            if RectList[i, j].sum < (Filter_Sum * RectList[i, j].count) then
              begin
                RectList[i, j].count := 0;
              end;


          end;
      end;
  setlength(path, 255);
  maxfillcount := 50;

  for i := 0 to w_r - 1 do
    for j := 0 to h_r - 1 do
      begin
        fillcount := 0;
        getFill(i, j, pt_1, maxfillcount + 1, path, fillcount);
        if fillcount <= maxfillcount then
          begin
            for idx := 0 to fillcount - 1 do
              begin
                RectList[path[idx].X, path[idx].y].count := 0;
              end;
          end;
      end;
  setlength(pt_1, 0);
  setlength(path, 0);


  Pcount := 0;
  for x := 1 to w - 2 do
    for y := 1 to h - 2 do
      begin
        if blist_diff[x, y] > 0 then
          inc(Pcount);
      end;
  c32.ARGB := clRed32;
  for x := 0 to w - 1 do
    for y := 0 to h - 1 do
      begin
        i := x div (r_count);
        j := y div (r_count);
        if RectList[i, j].count > 0 then
          c32.A := blist_diff[x, y]
        else
          c32.A := 0;
        bmp2.Pixel[x, y] := c32.ARGB;
      end;
  bmp2.DrawMode := dmBlend;
  for i := 0 to w_r - 1 do
    for j := 0 to h_r - 1 do
      begin
        if RectList[i, j].count > 0 then
          img.FrameRectS(RectList[i, j].rect, clBlue32);
      end;
  img.Draw(0, 0, bmp2);
  FreeAndNil(bmp2);

  for x := 0 to w - 1 do
    SetLength(blist[x], 0);
  SetLength(blist, 0);
  for x := 0 to w - 1 do
    SetLength(blist_diff[x], 0);
  SetLength(blist_diff, 0);
  for x := 0 to w_r - 1 do
    SetLength(RectList[x], 0);
  setlength(RectList, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  fn: string;
  bmp: TBitmap32;
begin
  fn := ExtractFilePath(Application.ExeName) + 'IMG_0023.JPG';
  bmp := TBitmap32.Create;
  bmp.LoadFromFile(fn);
  fn := fn + '.bmp';
  makeTable(bmp);
  bmp.SaveToFile(fn);
  Image1.Picture.LoadFromFile(fn);
end;

end.
相关推荐
akunkuntaimei12 分钟前
2026年高考数学各省真题及答案（完整版）
算法·高考
Hello:CodeWorld1 小时前
C 风格变参 vs C++ 变参模板：核心区别与选型指南
c语言·c++·算法
8Qi82 小时前
LeetCode 516：最长回文子序列
算法·leetcode·职场和发展·动态规划
zhangfeng11333 小时前
计算机视觉vc 3D 希尔伯特曲线 基础介绍，人工智能
人工智能·计算机视觉·3d
youngerwang3 小时前
【从搬运工到协处理器：网卡芯片架构、算法、验证与边缘演进深度剖析】
网络·算法·架构·芯片
KaMeidebaby4 小时前
卡梅德生物技术快报｜纯化重组蛋白实操详解
人工智能·python·tcp/ip·算法·机器学习
手写码匠4 小时前
从零实现 Prompt 工程引擎：结构化提示、自动优化与多轮自省体系
人工智能·深度学习·算法·aigc
CV-deeplearning5 小时前
YOLO26 正式发布！6 大任务一战封神，n 模型 mAP 40.9 跑 1.7ms，从检测到分割到姿态一条龙
yolo·目标检测·计算机视觉·ultralytics·yolo26
无限码力5 小时前
阿里算法岗 0530笔试真题 - 多约束条件下的元素匹配统计
算法·阿里笔试真题·阿里机试真题·阿里算法岗笔试
lqqjuly5 小时前
MLA — 多头潜在注意力深度解析
深度学习·神经网络·算法
热门推荐
01《置身钉内》原文-可播放阅读02GitHub 镜像站点03【AI】2026 年具身智能模型和世界模型总结04Codex 下载安装指南：Windows 和 macOS 官方版下载052026 AI 编程工具终极实战指南：Cursor vs Claude Code vs Copilot，开发者该怎么选？062026 年 AI 编程工具终极横评：Cursor vs Claude Code vs Copilot vs Windsurf07【踩坑记录 | 第一篇】微软商店无法使用时，如何手动安装 OpenAI Codex？附`.msix`文件系统错误解决方法08CC-Switch 下载、安装与使用配置指南【2026.5.29】09AI科技热点日报 | 2026年6月1日10CC-Switch & Claude 基于 Linux 服务器安装使用指南