Solved

how to separate the borderline on canvas?? ?

Posted on 2002-05-23
10
248 Views
Last Modified: 2010-04-04
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;
0
Comment
Question by:jbas
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
10 Comments
 

Author Comment

by:jbas
ID: 7030942
help!
0
 
LVL 1

Expert Comment

by:MBo
ID: 7031075
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;
0
 
LVL 4

Accepted Solution

by:
delphi3 earned 100 total points
ID: 7031298
Hi
I saved the web page and then saved the  image as a bitmap.
Then with my program I first loaded  the bitmap. To do this, first by double clicking in the image  area
and follow the instructions and then size to fit.  Run the program, press the Process button, observe ,
If you like it then Save it to a some name different than the original, Close the program

unit EEPixlHelperUnit1;
// I loaded the internet image into an image on the form.
// then processed the image. I first 'raised the few
// shapes that were black to be gray
// I then got  each pixel and then outlined each shape in black

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    SaveDialog1: TSaveDialog;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  IA, IB, M: Integer;
begin
 for IA := 1 to Form1.Image1.Picture.Width do
  begin
   for IB := 1 to Form1.Image1.Picture.Height do
    begin
      // $000000  is Black
       // $FFFFFF is White
      // the 2 black images are being raised to a lighter color
      if Form1.Image1.Canvas.Pixels[IA + 1, IB] =  $000000 then
        Form1.Image1.Canvas.Pixels[IA, IB] := $808080;
      if Form1.Image1.Canvas.Pixels[IA, IB + 1] =  $000000 then
        Form1.Image1.Canvas.Pixels[IA, IB] := $808080;
    end; //end for IB
   end; // end IA


  for IA := 1 to Form1.Image1.Picture.Width do
  begin
    for IB := 1 to Form1.Image1.Picture.Height do
    begin
      // $000000  is Black
      // $FFFFFF is White
      M := Form1.Image1.Canvas.Pixels[IA, IB];
      if Form1.Image1.Canvas.Pixels[IA + 1, IB] <> M then
        Form1.Image1.Canvas.Pixels[IA, IB] := $000000;
      if Form1.Image1.Canvas.Pixels[IA, IB + 1] <> M then
        Form1.Image1.Canvas.Pixels[IA, IB] := $000000;
    end; //end for IB
  end; // end IA

  repaint;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Form1.SaveDialog1.Execute then
    Form1.Image1.Picture.SaveToFile(SaveDialog1.FileName + '.bmp');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Application.Terminate;
end;
end.

form as Text:


object Form1: TForm1
  Left = 211
  Top = 120
  Width = 495
  Height = 316
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 120
  TextHeight = 16
  object Image1: TImage
    Left = 104
    Top = 32
    Width = 257
    Height = 193
  end
  object Button1: TButton
    Left = 392
    Top = 72
    Width = 75
    Height = 25
    Caption = 'Process'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 392
    Top = 120
    Width = 75
    Height = 25
    Caption = 'Save'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 392
    Top = 168
    Width = 75
    Height = 25
    Caption = 'Close'
    TabOrder = 2
    OnClick = Button3Click
  end
  object SaveDialog1: TSaveDialog
    Left = 384
    Top = 8
  end
end

Delphi3


0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:jbas
ID: 7031510
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!
0
 
LVL 4

Expert Comment

by:delphi3
ID: 7031791
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
0
 

Author Comment

by:jbas
ID: 7032285
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.
 
0
 
LVL 4

Expert Comment

by:delphi3
ID: 7032515
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
0
 

Author Comment

by:jbas
ID: 7033527
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.
0
 
LVL 4

Expert Comment

by:delphi3
ID: 7033576
email: bherbst65@hotmail.com
0
 

Author Comment

by:jbas
ID: 7033893
thanks to delphi3 and MBo!
my email:jbas@163.com
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Delphi: how to implement a User Shortcut mapper? 1 135
LAN or WAN ? 11 105
CheckListBox usage 3 81
How to remove Recent Projects from Embarcadero C++ builder XE10. Berlin 2 78
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question