Link to home
Start Free TrialLog in
Avatar of jbas
jbas

asked on

how to separate the borderline on canvas?? ?

hello experts:
i want to separate the borderline on paintbox.canvas,on the paintbox.canvas,the canvas is here:http://www26.brinkster.com/jbaswjy/default.htm
change the borderline to clblack color and change the other color
to clwhite.
my code not work well; help me!,thanks!

for I:=0 to paintbox1.Width-1 do
begin
for J:=0 to paintbox1.Height-1 do
begin
SBln:=false;
TempColor:=paintbox1.Canvas.Pixels[I,J];
Templcolor:=paintbox1.Canvas.Pixels[I-1,J];
Temprcolor:=paintbox1.Canvas.Pixels[I+1,J];
Temptcolor:=paintbox1.Canvas.Pixels[I,J-1];
Tempdcolor:=paintbox1.Canvas.Pixels[I,J+1];
if (TempColor=Templcolor)
or (TempColor=Temprcolor)
or (TempColor=Temptcolor)
or (TempColor=TempDcolor) then
SBln=true;
if SBln=true then
simulate.pntbx.Canvas.Pixels[I,J]:=clblack
else
simulate.pntbx.Canvas.Pixels[I,J]:=clwhite;
end;
end;
Avatar of jbas
jbas

ASKER

help!
procedure TForm1.Button1Click(Sender: TObject);
var b:tbitmap;
i,j:integer;
tempcolor:tcolor;
flag:boolean;
begin
b:=tbitmap.create;
b.LoadFromFile('e:\ls.bmp');
image1.Width:=b.Width;
image1.height:=b.height;
with b.canvas do begin
for i:=0 to b.Width-1 do
  for j:=0 to b.height-1 do begin
    tempcolor:=pixels[i,j];
    flag:=true;
    if (i>0) then
      if tempcolor<>pixels[i-1,j] then flag:=false;
    if (j>0) then
      if tempcolor<>pixels[i,j-1] then flag:=false;
    if (i<b.Width-1) then
      if tempcolor<>pixels[i+1,j] then flag:=false;
    if (i<b.Height-1) then
      if tempcolor<>pixels[i-1,j] then flag:=false;
  if flag then
    image1.Canvas.pixels[i,j]:=clWhite
      else
         image1.Canvas.pixels[i,j]:=clBlack;
  end;
end;
end;
ASKER CERTIFIED SOLUTION
Avatar of delphi3
delphi3

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of jbas

ASKER

thanks to all!
  your code can work well,but through this method
pixels[i-1,j]
pixels[i,j-1]
pixels[i+1,j]
pixels[i-1,j]
is not very exactitude!
because any line's width =two points'width.
 your have any exactitude method?
thanks!
jbas,
I would like a definition of your words 'is not very exactitude!'

Tell me what it is you really want to do. What does the white have to do with the shapes?


I thought it was to define each shape in the 'Is.bmp' to be outlined in black for viewing the faces with a single set of black pixels.



Delphi3
Avatar of jbas

ASKER

thanks to Delphi3!
  my english is poor,sorry!
  i want to produce a "Vornoi diagrami",and to simulate  the "crystal produce". now i produced the "Vornoi diagrami",but now i need to separate the outlined from the canvas,because i need the outlined point to work(i unfinished,because i unable:))
produce "vornoi diagrami" code ,it can work well:can you give me some Comment ?

unit main;
                                               
interface

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

type
  PXYLink=^XYLink;
  XYLink=record
    X,Y,Tag:Integer;
    Next:PXYLink;
  end;
  TXYLink=class
  private
    FPXYLink:PXYLink;
    FMemImg:array of array of Integer;
    FWidth,FHeight:Integer;
    FDefaultTag:Integer;
    procedure FreeList(var PList:PXYLink);
    procedure AddPointToList(X,Y,Tag:Integer;var PList:PXYLink);
  public
    procedure AddSeekPoint(X,Y,Tag:Integer);
  //  procedure SetPoint(X,Y:Integer;Value:Integer=0);
    function GetPoint(X,Y:Integer):Integer;
    procedure ExpandPointList;
    constructor Create(Width,Height,DefaultTag:Integer);
    destructor Destroy; override;
  end;
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    image1: TPaintBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   end;

var
  Form1: TForm1;
  implementation
{ TXYLink }

procedure TXYLink.AddPointToList(X, Y, Tag: Integer; var PList: PXYLink);
var
  m:PXYLink;
begin
  New(m);
  m.X:=X;
  m.Y:=Y;
  m.Tag:=Tag;
  m.Next:=PList;
  PList:=m;
end;

procedure TXYLink.AddSeekPoint(X, Y, Tag: Integer);
begin
  AddPointToList(X,Y,Tag,FPXYLink);
end;

constructor TXYLink.Create(Width, Height, DefaultTag: Integer);
var
  i:Integer;
begin
  FPXYLink:=nil;
  FWidth:=Width;
  FHeight:=Height;
  FDefaultTag:=DefaultTag;
  SetLength(FMemImg,FWidth);
  for i:=0 to FWidth-1 do
  begin
    SetLength(FMemImg[i],FHeight);
    FillChar(FMemImg[i][0],FHeight*SizeOf(Boolean),0);
  end;
end;

destructor TXYLink.Destroy;
var
  i:Integer;
begin
  FreeList(FPXYLink);
  for i:=0 to FWidth-1 do
    SetLength(FMemImg[i],0);
  SetLength(FMemImg,0);
  inherited;
end;

procedure TXYLink.ExpandPointList;
var
  Head,pm:PXYLink;
  procedure TestAndAdd(x0,y0,tag:Integer);
  begin
    if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
      if FMemImg[x0][y0]=FDefaultTag then
      begin
        AddPointToList(x0,y0,tag,Head);
        FMemImg[x0][y0]:=tag;
      end;
  end;
begin
  Head:=nil;
  pm:=FPXYLink;
  while pm<>nil do
  begin
    with pm^ do
    begin
      TestAndAdd(X-1,Y,Tag);
      TestAndAdd(X+1,Y,Tag);
      TestAndAdd(X,Y-1,Tag);
      TestAndAdd(X,Y+1,Tag);
    end;
    pm:=pm.Next;
  end;
  FreeList(FPXYLink);
  FPXYLink:=Head;
end;

procedure TXYLink.FreeList(var PList: PXYLink);
var
  m:PXYLink;
begin
  m:=PList;
  while m<>nil do
  begin
    m:=PList.Next;
    Dispose(PList);
    PList:=m;
  end;
  PList:=nil;
end;

function TXYLink.GetPoint(X, Y: Integer): Integer;
begin
  Result:=FMemImg[X][Y];
end;

{procedure TXYLink.SetPoint(X, Y: Integer; Value: Integer);
begin
  FMemImg[X][Y]:=Value;
end;}




{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  PointList:TXYLink;
  i,x,y:Integer;
begin
  PointList:=TXYLink.Create(image1.Width,image1.Height,Integer(clBlack)); //Integer(clBlack))=0
  for i:=1 to 400 do
  PointList.AddSeekPoint(random(image1.Width),random(image1.Height),Integer(rgb(i*10,I*50,I*100)));
  with Image1.Canvas do
  begin
    for i:=1 to 25 do
    begin
      PointList.ExpandPointList;
          for x:=0 to image1.Width-1 do
            for y:=0 to image1.Height-1 do
              Pixels[x,y]:=TColor(PointList.GetPoint(x,y));
          Application.ProcessMessages;
    end;
  end;
   PointList.Free;
application.MessageBox('finished!','',0);
end;


end.
 
jbas,
Are you wanting this????


 

prof. Joze Duhovnik's home pageprof. Jože Duhovnik's WWW page Jože Duhovnik ARTICLES AND CONTRIBUTIONS 1.01 Original scientific article 1. DUHOVNIK, Jože. O ustreznosti priporocila za dolocitev mere cez zobe po standardu JUS. Stroj. vestn., 1979, letn. 25, št. 5/6, str.
www.lecad.uni-lj.si/~duhovnik

 

Mreženje v 2D - VoronoiMreženje v 2D - Voronoi Abstrakt Crowd problems in the cumputer graphics to construct solvations on net final elements. At the most time this elements is a triangles but that triangles have corrected define a normal and that triangles are enough
ftp.lecad.uni-lj.si/pub/vaje/resitve/4.18/Html1.html 


http://www.lecad.uni-lj.si/~leon/research/meshing/node7.html#SECTION00024000000000000000



Adaptivno mrezenje z Vornoi diagrami (interno porocilo)Adaptivno mrezenje z Vornoi diagrami (interno porocilo)
www.lecad.uni-lj.si/~leon/research/meshing/meshing.html

I see the shapes develop  but Wow!!!! how to get them? My English is Ok but my other language necessary to read all of this is nill.

You want the lines that were used in the construction and not the resulting edges? Correct?


Delphi3
Avatar of jbas

ASKER

thanks to Delphi3!
    about the "Vornoi diagrami",above the URL's refer to
the method to get "Vornoi diagrami" is different from my method.get "Vornoi diagrami" is the first step ,and second is to simulate  the "crystal produce",but it is so complex,
i will work it continue.

BTW: i am a chinese,but not programer,and you? if you like
can you give me your email.
email: bherbst65@hotmail.com
Avatar of jbas

ASKER

thanks to delphi3 and MBo!
my email:jbas@163.com