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.Canva s.Pixels[I ,J];
Templcolor:=paintbox1.Canv as.Pixels[ I-1,J];
Temprcolor:=paintbox1.Canv as.Pixels[ I+1,J];
Temptcolor:=paintbox1.Canv as.Pixels[ I,J-1];
Tempdcolor:=paintbox1.Canv as.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.Pixe ls[I,J]:=c lblack
else
simulate.pntbx.Canvas.Pixe ls[I,J]:=c lwhite;
end;
end;
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.Canva
Templcolor:=paintbox1.Canv
Temprcolor:=paintbox1.Canv
Temptcolor:=paintbox1.Canv
Tempdcolor:=paintbox1.Canv
if (TempColor=Templcolor)
or (TempColor=Temprcolor)
or (TempColor=Temptcolor)
or (TempColor=TempDcolor) then
SBln=true;
if SBln=true then
simulate.pntbx.Canvas.Pixe
else
simulate.pntbx.Canvas.Pixe
end;
end;
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;
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]:
else
image1.Canvas.pixels[i,j]:
end;
end;
end;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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!
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
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
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:Int eger;var PList:PXYLink);
public
procedure AddSeekPoint(X,Y,Tag:Integ er);
// procedure SetPoint(X,Y:Integer;Value :Integer=0 );
function GetPoint(X,Y:Integer):Inte ger;
procedure ExpandPointList;
constructor Create(Width,Height,Defaul tTag:Integ er);
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,FPX YLink);
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],FHeig ht);
FillChar(FMemImg[i][0],FHe ight*SizeO f(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:Integ er);
begin
if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
if FMemImg[x0][y0]=FDefaultTa g then
begin
AddPointToList(x0,y0,tag,H ead);
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.Wid th,image1. Height,Int eger(clBla ck)); //Integer(clBlack))=0
for i:=1 to 400 do
PointList.AddSeekPoint(ran dom(image1 .Width),ra ndom(image 1.Height), Integer(rg b(i*10,I*5 0,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(PointL ist.GetPoi nt(x,y));
Application.ProcessMessage s;
end;
end;
PointList.Free;
application.MessageBox('fi nished!',' ',0);
end;
end.
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:Int
public
procedure AddSeekPoint(X,Y,Tag:Integ
// procedure SetPoint(X,Y:Integer;Value
function GetPoint(X,Y:Integer):Inte
procedure ExpandPointList;
constructor Create(Width,Height,Defaul
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,FPX
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],FHeig
FillChar(FMemImg[i][0],FHe
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:Integ
begin
if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
if FMemImg[x0][y0]=FDefaultTa
begin
AddPointToList(x0,y0,tag,H
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
var
PointList:TXYLink;
i,x,y:Integer;
begin
PointList:=TXYLink.Create(
for i:=1 to 400 do
PointList.AddSeekPoint(ran
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(PointL
Application.ProcessMessage
end;
end;
PointList.Free;
application.MessageBox('fi
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
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
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.
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
ASKER
thanks to delphi3 and MBo!
my email:jbas@163.com
my email:jbas@163.com
ASKER