ru.algorithms

 
 - RU.ALGORITHMS ----------------------------------------------------------------
 From : Alex Astafiev                        2:5000/228.16  17 Jul 2001  08:35:09
 To : Nicolas Rudnev
 Subject : Обход по границе
 -------------------------------------------------------------------------------- 
 

 
  NR>   Вот такая задача: на плоскости есть область произвольной формы (без
  NR> "дырок", т.е. односвязная, насколько я помню), задаются координаты
  NR> точки, лежащей внутри области, надо найти точки, которые определяют
  NR> границу этой области. Вроде все тривиально, но чего-то никак не
  NR> складывается, может есть какой уже описанный алгоритм под это дело?
  NR> Отпишите, или ссылку бросьте...
 
 FindEdges, мне это требовалось для реализации антиалиасинга по краям области, я 
 в таких краях делал Alpha=50%
 
 Работает этот простейший алгоритм на растровой сетке. Я перебираю все
 изображение. Hо его можно оптимизнуть и перебирать лишь те точки, что
 удовлетворяют условию "solid fill", т.е. заливки с затравкой.
 
 я четырехсвязно проверяю каждый пиксел растра, если проверяемый в данный момент 
 пиксел (текущий) принадлежит телу и у него есть справа или слева или сверху или 
 снизу соседи - то этот пиксель принадлежит границе.
 Исходник проще тысячи слов:
 ==== Begin of mainunit.pas ====
 unit MainUnit;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Grids;
 
 type
   NArray = array [0..31] of array [0..31] of Byte;
   TfmMain = class(TForm)
     Grid: TDrawGrid;
     procedure FormKeyDown(Sender: TObject; var Key: Word;
       Shift: TShiftState);
     procedure FormCreate(Sender: TObject);
     procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;
       Rect: TRect; State: TGridDrawState);
   private
   public
     GfxArray: NArray;
     GridArray: NArray;
     procedure FindEdges;
   end;
 
 var
   fmMain: TfmMain;
 
 implementation
 
 {$R *.DFM}
 
 procedure TfmMain.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
     if key in [vk_escape] then Close
     else
     if key in [vk_Return] then
     begin
         FindEdges;
         Grid.Refresh;
     end
     else
     if key in [vk_space] then
     begin
         GridArray := GfxArray;
         Grid.Refresh;
     end;
 end;
 
 procedure TfmMain.FormCreate(Sender: TObject);
 var
     Bitmap: TBitmap;
     X,Y: Integer;
 begin
     Bitmap := TBitmap.Create;
     try
         Bitmap.Loadfromfile('image.bmp');
         for Y := 0 to Bitmap.Width -1 do
             for X := 0 to Bitmap.height -1 do
             begin
                 if Bitmap.Canvas.Pixels[X,Y] <> clBlack then
                     GfxArray[X,Y] := 1
                 else
                     GfxArray[X,Y] := 0;
             end;
     finally
         Bitmap.Free;
     end;
     GridArray := GfxArray;
 end;
 
 procedure TfmMain.FindEdges;
 var
     X,Y: 0..30;
     TempArray: Narray;
 
     function ATst(X,Y: Integer): Boolean;
     begin
         Result := (GfxArray[X,Y] = 0);
     end;
 
 begin
     TempArray := gfxArray;
     for Y := 1 to 30 do
         for X := 1 to 30 do
         begin
             if GfxArray[X,Y] = 1 then
             begin
                 if Atst(X,Y-1) or Atst(X-1,Y) or Atst(X+1,Y) or Atst(X,Y+1) then
                     TempArray[X,Y] := 2
             end
             else
                 TempArray[X,Y] := GfxArray[X,Y];
         end;
     GridArray := TempArray;
 end;
 
 procedure TfmMain.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
   Rect: TRect; State: TGridDrawState);
 
     procedure SetColor(AColor: TColor);
     begin
         Grid.Canvas.brush.color := AColor;
         Grid.Canvas.FillRect(Rect);
     end;
 var
     GfxValue: Byte;
 begin
     if ( gdselected in state ) or ( gdFocused in state ) or (  gdFixed in state 
 )   then exit;
     GfxValue :=  GridArray[ACol, ARow];
     case GfxValue of
     0:
         SetColor(clWhite);
     1:
         SetColor(clBlue);
     2:
         SetColor(clGreen);
     end;
 end;
 end.
 ==== End of mainunit.pas ====
 
 ==== Begin of mainunit.dfm ====
 object fmMain: TfmMain
   Left = 358
   Top = 99
   Width = 308
   Height = 328
   Caption = 'fmMain'
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   KeyPreview = True
   OldCreateOrder = False
   OnCreate = FormCreate
   OnKeyDown = FormKeyDown
   PixelsPerInch = 96
   TextHeight = 13
   object Grid: TDrawGrid
     Left = 0
     Top = 0
     Width = 300
     Height = 301
     Align = alClient
     ColCount = 32
     DefaultColWidth = 8
     DefaultRowHeight = 8
     FixedCols = 0
     RowCount = 32
     FixedRows = 0
     TabOrder = 0
     OnDrawCell = GridDrawCell
   end
 end
 ==== End of mainunit.dfm ====
 
 --- Alex Raider / Flash inc.
  * Origin: Alex Raider/ Flash inc. 1992-2001 (2:5000/228.16)
 
 

Вернуться к списку тем, сортированных по: возрастание даты  уменьшение даты  тема  автор 

Тема:    Автор:    Дата:    Обход по границе   Nicolas Rudnev   16 Jul 2001 13:26:04   Обход по границе   Konstantin S. Rabkin   16 Jul 2001 14:23:54   Обход по границе   Nicolas Rudnev   16 Jul 2001 18:12:58   Обход по границе   Vladimir Polyanin   17 Jul 2001 23:31:42   Обход по гpанице   Alex Grishuk   23 Jul 2001 15:40:00   Обход по границе   Alex Astafiev   17 Jul 2001 08:35:09