Solved

how to separate the borderline on canvas?? ?

Posted on 2002-05-23
10
243 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
  • 5
  • 4
10 Comments
 

Author Comment

by:jbas
Comment Utility
help!
0
 
LVL 1

Expert Comment

by:MBo
Comment Utility
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
Comment Utility
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
 

Author Comment

by:jbas
Comment Utility
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
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:jbas
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
email: bherbst65@hotmail.com
0
 

Author Comment

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

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

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…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

743 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now