Visual select image part from image?

Question

Greeting!

I have a special image:

With what algorithm or code can I select a sub-image part from this image and visually see what I am currently selecting?

Each sub-image part is delimited from others by 1 pixel with a special color (In my example, it is Fuchsia).

Sub-images (or any of them) may have any form and size.

Answer 1

Here is an example of finding subimages in your image.

This example is capable of finding any subimages with convex shape (rectangles, triangles, circles, etc). But it won't work correctly on concave shapes. For those you need to modify algorithm so that once you find first pixel you then go and scan for all nearbyones with similar algorithm as flod fill.

And here is the code:

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls;

type
  TSubImage = record
    LeftBound: Integer;
    RightBound: Integer;
    TopBound: Integer;
    BottomBound: Integer;
  end;

  ASubImages = Array of TSubImage;

  TForm2 = class(TForm)
    Button1: TButton;
    SourceImage: TImage;
    ListView1: TListView;
    SelectionImage: TImage;
    procedure Button1Click(Sender: TObject);
    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure SelectionImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  SubImages: ASubImages;

implementation

{$R *.dfm}

procedure FindSubimages(Bitmap: TBitmap; var Subimages: ASubImages);
var X,Y,I: Integer;
    //2D array we use to store to which image does which pixel belong
    SubImagesMap: Array of Array of Integer;
begin
  //Set the map dimension to the same dimension of TBitmap we scan
  SetLength(SubImagesMap,Bitmap.Width+1,Bitmap.Height+1);
  for Y := 0 to Bitmap.Height-1 do
  begin
    for X := 0 to Bitmap.Width-1 do
    begin
      //Check to see if current pixel color is not of background color.
      if Bitmap.Canvas.Pixels[X,Y] <> clFuchsia then
      begin
        //Check if we already moved rightward (current pixel X postion > 0)
        if X > 0 then
        begin
          //Check if pixel to the left has already been assigned to a subimage number
          //and assign current pixel to the same subimage number since they are adjenct
          if SubImagesMap[X-1,Y] <> 0 then
          begin
            SubImagesMap[X,Y] := SubImagesMap[X-1,Y];

            //Here we are checking to see if current pixel is placed outside of subimage
            //bonds and adjust them acordingly
            //Check to se if pixel X position is leftwards to subimages left bound
            if Subimages[SubImagesMap[X,Y]-1].LeftBound > X then
              //Move subimage left bound to match pixel X position
              Subimages[SubImagesMap[X,Y]-1].LeftBound := X;
            //Check to se if pixel X position is rightwards to subimages right bound
            if Subimages[SubImagesMap[X,Y]-1].RightBound < X then
              //Move subimage right bound to match pixel X position
              Subimages[SubImagesMap[X,Y]-1].RightBound := X;
            //Check to se if pixel Y position is upwards to subimages top bound
            if Subimages[SubImagesMap[X,Y]-1].TopBound > Y then
              //Move subimage top bound to match pixel Y position
              Subimages[SubImagesMap[X,Y]-1].TopBound := Y;
            //Check to se if pixel Y position is downwards to subimages bottom bound
            if Subimages[SubImagesMap[X,Y]-1].BottomBound < Y then
              //Move subimage bottom bound to match pixel Y position
              Subimages[SubImagesMap[X,Y]-1].BottomBound := Y;
          end;
        end;
        //Check if we already moved downward (current pixel Y position > 0)
        if Y > 0 then
        begin
          //Check if pixel above has already been assigned to a subimage number
          //and assign current pixel to the same subimage number since they are adjenct
          if SubImagesMap[X,Y-1] <> 0 then
          begin
            SubImagesMap[X,Y] := SubImagesMap[X,Y-1];

            //Here we are checking to see if current pixel is placed outside of subimage
            //bonds and adjust them acordingly
            //Check to se if pixel X position is leftwards to subimages left bound
            if Subimages[SubImagesMap[X,Y]-1].LeftBound > X then
              //Move subimage left bound to match pixel X position
              Subimages[SubImagesMap[X,Y]-1].LeftBound := X;
            //Check to se if pixel X position is rightwards to subimages right bound
            if Subimages[SubImagesMap[X,Y]-1].RightBound < X then
              //Move subimage right bound to match pixel X position
              Subimages[SubImagesMap[X,Y]-1].RightBound := X;
            //Check to se if pixel Y position is upwards to subimages top bound
            if Subimages[SubImagesMap[X,Y]-1].TopBound > Y then
              //Move subimage top bound to match pixel Y position
              Subimages[SubImagesMap[X,Y]-1].TopBound := Y;
            //Check to se if pixel Y position is downwards to subimages bottom bound
            if Subimages[SubImagesMap[X,Y]-1].BottomBound < Y then
              //Move subimage bottom bound to match pixel Y position
              Subimages[SubImagesMap[X,Y]-1].BottomBound := Y;
          end;
        end;
        //Check to see if current pixel has already been asigned a sibimage number
        //I not we create a new subimage entry and assign its number to current pixel
        if SubImagesMap[X,Y] = 0 then
        begin
          //Increase the size of dynamic array storing subimage records
          SetLength(SubImages,Length(SubImages)+1);

          //Assing current pixel the number of newly created subimage
          SubImagesMap[X,Y] := Length(SubImages);

          //Set subimage initial bounds which are coordinates of one pixel
          //since we created new subimage for this pixel
          SubImages[SubImagesMap[X,Y]-1].LeftBound := X;
          SubImages[SubImagesMap[X,Y]-1].RightBound := X;
          SubImages[SubImagesMap[X,Y]-1].TopBound := Y;
          SubImages[SubImagesMap[X,Y]-1].BottomBound := Y;
        end;
      end;
    end;
  end;
  //Reduce the size of SubImageMap array to free its memory
  //Since SubImageMap is local array this is optional
  SetLength(SubImagesMap,0,0);
end;

procedure TForm2.Button1Click(Sender: TObject);
var I: Integer;
    ListItem: TListItem;
    ListColumn: TListColumn;
begin
  //Our procedure for finding subimages. It accepts two parameters
  //First parameter is reference to TBitmap object containing original image
  //Second is reference to variable in which subimage bouns will be stored to
  FindSubimages(SourceImage.Picture.Bitmap, Subimages);
  //Lets show our results in more readable format
  //First we change the ListView style to vsReport so we can show our results
  //in multiple columns
  ListView1.ViewStyle := vsReport;
  //Then we add necessary columns
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Subimage number';
  ListColumn.Width := 100;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Left Bound';
  ListColumn.Width := 80;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Right Bound';
  ListColumn.Width := 80;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Top Bound';
  ListColumn.Width := 80;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Bottom Bound';
  ListColumn.Width := 80;
  //Iterate through all subimages and add data to ListView
  for I := 0 to Length(Subimages)-1 do
  begin
    //Ad new item to list view
    ListItem := ListView1.Items.Add;
    //Use the reference of newly added item to set caption which will be the text
    //in first column
    ListItem.Caption := IntToStr(I+1);
    //Add aditional subitems. Each of this subitems is shown in its own column
    //NOTE: Make sure to have enough columns to show all subitems
    //If you wanna field in certain column to be empty just pass an empty string ''
    ListItem.SubItems.Add(IntToStr(SubImages[I].LeftBound));
    ListItem.SubItems.Add(IntToStr(SubImages[I].RightBound));
    ListItem.SubItems.Add(IntToStr(SubImages[I].TopBound));
    ListItem.SubItems.Add(IntToStr(SubImages[I].BottomBound));
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  //Make selection image 2 pixels larger so we will never draw right to the edge
  //and therefore can easily use its defult transparency
  SelectionImage.Width := SourceImage.Width+2;
  SelectionImage.Height := SourceImage.Height+2;
  //Shift selector image position one to the left and one up to be centered above
  //SourceIMage.
  SelectionImage.Left := SourceImage.Left-1;
  SelectionImage.Top := SourceImage.Top-1;
end;

procedure TForm2.ListView1SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var Rect: TRect;
begin
  //Use SubImage bounds to form rectagnle we will use for our selection
  Rect.Left := SubImages[Item.Index].LeftBound+1;
  Rect.Right := SubImages[Item.Index].RightBound+2;
  Rect.Top := SubImages[Item.Index].TopBound+1;
  Rect.Bottom := SubImages[Item.Index].BottomBound+2;
  //Clear previous selection
  SelectionImage.Canvas.Brush.Color := clFuchsia;
  SelectionImage.Canvas.FillRect(SelectionImage.Canvas.ClipRect);
  //Draw new selection rectangle
  SelectionImage.Canvas.Brush.Color := clLime;
  SelectionImage.Canvas.FrameRect(Rect);
end;

procedure TForm2.SelectionImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Form2.Caption := IntToStr(X);
end;

end.