Delphi - Graphic editor / take 2

disclaimer

the source code of this page may not appear correctly in certain browsers
due to special characters. Have a look at the source of this HTML page
with notepad instead

Graphic editor

The featured graphic editor is a demo to show some capabilities. It is not
intended to be a tool. It is a further development from graphic editor /take 1
It has part of the drawing moved into graphic classes. Further editing capabilities :

lines and rectangles as objects
objects are moveable and resizeable
select and change color of an object

It is based on a TImage.
Plus, it shows the useage of rubber banding.
Concepts, such as selection are considered first shots and require proper definition and refinement.

the code GraphicClasses.pas

unit GraphicClasses;

interface

uses
  SysUtils, Classes, Graphics, ExtCtrls;

type
  TGraphicBase = class(TObject)
  private
    { Private declarations }
   frpoint:byte;
   fimage:TImage;
  protected
    { Protected declarations }
   procedure selectbox(x,y:integer);
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; virtual; abstract;
   procedure select(x,y:integer); overload; virtual; abstract;
   procedure move(x,y:integer);   virtual; abstract;
   procedure size(x,y:integer);   virtual; abstract;
   procedure redraw; virtual; abstract;
   procedure select; overload; virtual; abstract;
   procedure unselect; virtual; abstract;
  published
    { Published declarations }
   property refpoint:byte read frpoint write frpoint;
   property Image:TImage read fimage write fimage;
  end;

  TGraphicLine =class(TGraphicBase)
  private
    { Private declarations }
   fx1,fx2,fy1,fy2:integer;
   fcolor:TColor;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; override;
   procedure select(x,y:integer); override;
   procedure move(x,y:integer); override;
   procedure size(x,y:integer); override;
   procedure redraw; override;
   procedure select; override;
   procedure unselect; override;
  published
    { Published declarations }
   property x1:integer read fx1 write fx1;
   property y1:integer read fy1 write fy1;
   property x2:integer read fx2 write fx2;
   property y2:integer read fy2 write fy2;
   property color:TColor read fcolor write fcolor;
  end;

  TGraphicRect =class(TGraphicBase)
  private
    { Private declarations }
   fx1,fx2,fy1,fy2:integer;
   fcolor:TColor;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create(image:TImage);
   function isobject(x,y:integer):boolean; override;
   procedure select(x,y:integer); override;
   procedure move(x,y:integer); override;
   procedure size(x,y:integer); override;
   procedure redraw; override;
   procedure select; override;
   procedure unselect; override;
  published
    { Published declarations }
   property x1:integer read fx1 write fx1;
   property y1:integer read fy1 write fy1;
   property x2:integer read fx2 write fx2;
   property y2:integer read fy2 write fy2;
   property color:TColor read fcolor write fcolor;
  end;

  TGraphicList=class(TObject)
  private
    { Private declarations }
    flist:TList;
    fimage:TImage;
  protected
    { Protected declarations }
  public
    { Public declarations }
   constructor create;
   function isobject(x,y:integer;var p:TGraphicBase; var j:integer):boolean;
   procedure add(u:TGraphicBase);
   procedure clear;
  published
    { Published declarations }
   property Image:TImage read fimage write fimage;
  end;


procedure Register;

implementation

const
 epsilon=4; //distance uncertainity

constructor TGraphicBase.create(image:TImage);
begin
 inherited create;
 fimage:=image;
end;

// black rectangle removes itself the second time
procedure TGraphicBase.selectbox(x,y:integer);
begin
 image.canvas.pen.color:=clwhite;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(x-2,y-2);
 image.Canvas.LineTo(x+2,y-2);
 image.Canvas.LineTo(x+2,y+2);
 image.Canvas.LineTo(x-2,y+2);
 image.Canvas.LineTo(x-2,y-2);
end;
//............................................................................
constructor TGraphicLine.create(image:TImage);
begin
 inherited create(image);
end;

// check start & end points
function TGraphicLine.isobject(x,y:integer):boolean;
begin
 result:=((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon));
end;

// check which corner is selected
procedure TGraphicLine.select(x,y:integer);
begin
 frpoint:=0;
 if ((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=1
 else begin
  if ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=2;
 end;
end;

// assumes the line is drawn - just move it
procedure TGraphicLine.move(x,y:integer);
begin
 image.canvas.pen.color:=clwhite xor fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  fx2:=fx2+(x-fx1);
  fy2:=fy2+(y-fy1);
  fx1:=x; fy1:=y;
 end;
 if frpoint=2 then begin
  fx1:=fx1+(x-fx2);
  fy1:=fy1+(y-fy2);
  fx2:=x; fy2:=y;
 end;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;

// move either point only
procedure TGraphicLine.size(x,y:integer);
begin
 image.canvas.pen.color:=clwhite xor fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  fx1:=x; fy1:=y;
 end;
 if frpoint=2 then begin
  fx2:=x; fy2:=y;
 end;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;

procedure TGraphicLine.redraw;
begin
 image.canvas.pen.color:=fcolor;
 image.Canvas.Pen.Mode:=pmCopy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy2);
end;

procedure TGraphicLine.select;
begin
 selectbox(x1,y1);
 selectbox(x2,y2);
end;

procedure TGraphicLine.unselect;
begin
 selectbox(x1,y1);
 selectbox(x2,y2);
end;
//............................................................................
constructor TGraphicRect.create(image:TImage);
begin
 inherited create(image);
end;

//check all corners
function TGraphicRect.isobject(x,y:integer):boolean;
begin
 result:=((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon))or
         ((abs(x-fx1)< epsilon)and(abs(y-fy2)< epsilon))or
         ((abs(x-fx2)< epsilon)and(abs(y-fy1)< epsilon));
end;

// check which corner is selected
procedure TGraphicRect.select(x,y:integer);
begin
 frpoint:=0;
 if ((abs(x-fx1)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=1
 else
  if ((abs(x-fx2)< epsilon)and(abs(y-fy1)< epsilon)) then frpoint:=2
  else
   if ((abs(x-fx2)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=3
   else
    if ((abs(x-fx1)< epsilon)and(abs(y-fy2)< epsilon)) then frpoint:=4;

end;

// move all points
procedure TGraphicRect.move(x,y:integer);
var dx,dy:integer;
begin
 dx:=0; dy:=0;
 image.canvas.pen.color:=clwhite XOR fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  dx:=x-fx1; dy:=y-fy1;
 end;
 if frpoint=2 then begin
  dx:=x-fx2; dy:=y-fy1;
 end;
 if frpoint=3 then begin
  dx:=x-fx2; dy:=y-fy2;
 end;
 if frpoint=4 then begin
  dx:=x-fx1; dy:=y-fy2;
 end;
 fx1:=fx1+dx; fx2:=fx2+dx;
 fy1:=fy1+dy; fy2:=fy2+dy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;

// move one corner only
procedure TGraphicRect.size(x,y:integer);
var dx,dy:integer;
begin
 dx:=0; dy:=0;
 image.canvas.pen.color:=clwhite XOR fcolor;
 image.Canvas.Pen.Mode:=pmXOR;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
 image.Canvas.Pen.Mode:=pmXOR;
 if frpoint=1 then begin
  dx:=x-fx1; dy:=y-fy1;
  fx1:=fx1+dx;fy1:=fy1+dy;
 end;
 if frpoint=2 then begin
  dx:=x-fx2; dy:=y-fy1;
  fx2:=fx2+dx;fy1:=fy1+dy;
 end;
 if frpoint=3 then begin
  dx:=x-fx2; dy:=y-fy2;
  fx2:=fx2+dx; fy2:=fy2+dy;
 end;
 if frpoint=4 then begin
  dx:=x-fx1; dy:=y-fy2;
  fx1:=fx1+dx;fy2:=fy2+dy;
 end;
 //fx1:=fx1+dx; fx2:=fx2+dx;
 //fy1:=fy1+dy; fy2:=fy2+dy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;

procedure TGraphicRect.redraw;
begin
 image.canvas.pen.color:=fcolor;
 image.Canvas.Pen.Mode:=pmCopy;
 image.Canvas.MoveTo(fx1,fy1);
 image.Canvas.LineTo(fx2,fy1);
 image.Canvas.LineTo(fx2,fy2);
 image.Canvas.LineTo(fx1,fy2);
 image.Canvas.LineTo(fx1,fy1);
end;

procedure TGraphicRect.select;
begin
 selectbox(x1,y1);
 selectbox(x2,y1);
 selectbox(x2,y2);
 selectbox(x1,y2);
end;
procedure TGraphicRect.unselect;
begin
 selectbox(x1,y1);
 selectbox(x2,y1);
 selectbox(x2,y2);
 selectbox(x1,y2);
end;
//............................................................................
constructor TGraphicList.create;
begin
 inherited create;
 flist:=TList.create;
end;


function TGraphicList.isobject(x,y:integer;var p:TGraphicBase; var j:integer):boolean;
var i:integer;
begin
 i:=0; result:=false;
 while (not result)and(i < (fList.count)) do begin
  p:=TGraphicBase(flist.items[i]);
  //if p is TGraphicLine
   if p.isobject(x,y) then result:=true
   else inc(i);
  end; // while
end;

procedure TGraphicList.add(u:TGraphicBase);
begin
 flist.add(u);
end;

procedure TGraphicList.clear;
var i:integer;
 p:TGraphicBase;
begin
 while flist.count>0 do begin
  p:=flist[flist.count-1];
  p.Destroy;
  end;
end;
//............................................................................
procedure Register;
begin
  //RegisterComponents('Samples', [TGraphicClasses]);
end;

end.

the main code

unit Graphicstest1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    GroupBox1: TGroupBox;
    LineLabel: TLabel;
    ColorLabel: TLabel;
    RectLabel: TLabel;
    PopupMenu1: TPopupMenu;
    ClearAll: TMenuItem;
    ColorDialog1: TColorDialog;
    freehandlabel: TLabel;
    Grablabel: TLabel;
    SizeLabel: TLabel;
    Selectlabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure LineLabelClick(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClearAllClick(Sender: TObject);
    procedure ColorLabelClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure RectLabelClick(Sender: TObject);
    procedure freehandlabelClick(Sender: TObject);
    procedure GrablabelClick(Sender: TObject);
    procedure SizeLabelClick(Sender: TObject);
    procedure SelectlabelClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   lastx,lasty:integer;
   startx,starty:integer;
   state:integer;
   DrawColor:TColor;
   ObjectList:TGraphicList; // objects
   SelectedObject:TGraphicBase;
   SelectedIndex:integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}



procedure TForm1.FormCreate(Sender: TObject);
begin
 state:=0;
 image1.canvas.pen.Color:=clwhite;
 image1.Canvas.Brush.Color:=clwhite;
 image1.Canvas.Rectangle(0,0,image1.width-1,image1.height-1);
 image1.canvas.pen.Color:=clblack;
 ObjectList:=TGraphicList.Create;
 Objectlist.Image:=Image1;
 SelectedObject:=nil;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 //
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 groupbox1.width:=clientwidth;
 image1.width:=clientwidth;
 image1.Height:=clientheight-60;
 image1.picture.bitmap.width:=image1.width;
 image1.picture.bitmap.height:=image1.Height;
end;

procedure TForm1.LineLabelClick(Sender: TObject);
begin
 state:=1;
 rectlabel.Color:=clbtnface;
 linelabel.Color:=clwhite;
 freehandlabel.color:=clbtnface;
 grablabel.Color:=clbtnface;
 Sizelabel.Color:=clbtnface;
 selectlabel.Color:=clbtnface;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;

procedure TForm1.RectLabelClick(Sender: TObject);
begin
 state:=3;
 linelabel.Color:=clbtnface;
 rectlabel.Color:=clwhite;
 freehandlabel.color:=clbtnface;
 grablabel.Color:=clbtnface;
 Sizelabel.Color:=clbtnface;
 selectlabel.Color:=clbtnface;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;

procedure TForm1.freehandlabelClick(Sender: TObject);
begin
 state:=5;
 linelabel.Color:=clbtnface;
 rectlabel.Color:=clbtnface;
 freehandlabel.color:=clwhite;
 grablabel.Color:=clbtnface;
 Sizelabel.Color:=clbtnface;
 selectlabel.Color:=clbtnface;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;

procedure TForm1.GrablabelClick(Sender: TObject);
begin
 state:=7;
 linelabel.Color:=clbtnface;
 rectlabel.Color:=clbtnface;
 freehandlabel.color:=clbtnface;
 grablabel.Color:=clwhite;
 Sizelabel.Color:=clbtnface;
 selectlabel.Color:=clbtnface;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;

procedure TForm1.SizeLabelClick(Sender: TObject);
begin
 state:=9;
 linelabel.Color:=clbtnface;
 rectlabel.Color:=clbtnface;
 freehandlabel.color:=clbtnface;
 grablabel.Color:=clbtnface;
 Sizelabel.Color:=clwhite;
 selectlabel.Color:=clbtnface;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;

procedure TForm1.SelectlabelClick(Sender: TObject);
begin
 state:=11;
 linelabel.Color:=clbtnface;
 rectlabel.Color:=clbtnface;
 freehandlabel.color:=clbtnface;
 grablabel.Color:=clbtnface;
 Sizelabel.Color:=clbtnface;
 selectlabel.Color:=clwhite;
 If SelectedObject <> nil then SelectedObject.unselect;
 SelectedObject:=nil;
end;


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var i:integer;
p:TGraphicBase;
begin
 if state=1 then begin  // linemode - start line
  startx:=x; starty:=y;
  lastx:=x;lasty:=y;
  state:=2;
  image1.Canvas.Pen.Color:=clwhite;
 end;
 if state=3 then begin // rect mode - start rectangle
  startx:=x; starty:=y;
  lastx:=x;lasty:=y;
  state:=4;
  image1.Canvas.Pen.Color:=clwhite;
  image1.Canvas.Brush.Color:=clwhite;
 end;
 if state=5 then begin // freehand mode - start
  image1.Canvas.Pen.Color:=drawcolor;
  state:=6;
  end;
 if state=7 then begin // grab mode - start
  if ObjectList.isobject(x,y,p,i) then begin
   p.select(x,y);
   SelectedObject:=p;
   SelectedIndex:=i;
   image1.Cursor:=crDrag;
   State:=8;
  end;
 end;
 if state=9 then begin // size mode - start
  if ObjectList.isobject(x,y,p,i) then begin
   p.select(x,y);
   SelectedObject:=p;
   SelectedIndex:=i;
   image1.Cursor:=crSizeAll;
   State:=10;
  end;
 end;
 if state=11 then begin // size mode - start
  if ObjectList.isobject(x,y,p,i) then begin
   p.select(x,y);
   If SelectedObject<>nil then SelectedObject.unselect;
   SelectedObject:=p;
   SelectedIndex:=i;
   //image1.Cursor:=crSizeAll;
   State:=12;
  end
  else SelectedObject:=nil;
 end;
end;


procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var p:TGraphicBase;
i:integer;
begin
 if ObjectList.isobject(x,y,p,i) then statusbar1.panels[1].text:='found'
 else statusbar1.panels[1].text:='status';
 if state=2 then begin   // linemode - draw
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(lastx,lasty);
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(x,y);
  lastx:=x; lasty:=y;
  end;
 if state=4 then begin   // rectmode - draw
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(startx,lasty);
  image1.Canvas.LineTo(lastx,lasty);
  image1.Canvas.LineTo(lastx,starty);
  image1.Canvas.LineTo(startx,starty);
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(startx,y);
  image1.Canvas.LineTo(x,y);
  image1.Canvas.LineTo(x,starty);
  image1.Canvas.LineTo(startx,starty);
  lastx:=x; lasty:=y;
  end;
 if state=6 then begin // freehand mode - draw
  image1.canvas.Pixels[x,y]:=drawcolor;

 end;
 if state=8 then begin // grab mode
  SelectedObject.move(x,y);
 end;
 if state=10 then begin // size mode
  SelectedObject.size(x,y);
 end;
 statusbar1.Panels[0].Text:='mouse '+inttostr(x)+' '+inttostr(y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var Line:TGraphicLine;
    GRect:TGraphicRect;
begin
 if state=2 then begin  // linemode - end line
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(lastx,lasty);
  image1.Canvas.Pen.Color:=drawcolor;
  image1.Canvas.Pen.Mode:=pmCopy;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(lastx,lasty);
  state:=1;
  // create object
  Line:=TGraphicLine.create(image1);
  Line.x1:=startx; Line.x2:=lastx;
  Line.y1:=starty; line.y2:=lasty;
  line.color:=drawcolor;
  Objectlist.add(Line);
  end;
 if state=4 then begin  // rectmode - end line
  image1.Canvas.Pen.Mode:=pmXOR;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(startx,lasty);
  image1.Canvas.LineTo(lastx,lasty);
  image1.Canvas.LineTo(lastx,starty);
  image1.Canvas.LineTo(startx,starty);
  image1.Canvas.Pen.Color:=drawcolor;
  image1.Canvas.Brush.Color:=drawcolor;
  image1.Canvas.Pen.Mode:=pmCopy;
  image1.Canvas.MoveTo(startx,starty);
  image1.Canvas.LineTo(startx,lasty);
  image1.Canvas.LineTo(lastx,lasty);
  image1.Canvas.LineTo(lastx,starty);
  image1.Canvas.LineTo(startx,starty);
  state:=3;
  // create object
  GRect:=TGraphicRect.create(image1);
  GRect.x1:=startx; GRect.x2:=lastx;
  GRect.y1:=starty; GRect.y2:=lasty;
  GRect.color:=drawcolor;
  Objectlist.add(GRect);
  end;
 if state=6 then begin // freehand mode
  state:=5;
  end;
 if state=8 then begin // grab mode
  image1.Cursor:=crCross;
  state:=7;
  end;
 if state=10 then begin // size mode
  image1.Cursor:=crCross;
  state:=9;
  end;
 if state=12 then begin // select mode
  if SelectedObject <> nil then SelectedObject.select;
  state:=11;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if key=$1B then begin
  if state=1 then linelabel.Color:=clbtnface;
  if state=3 then rectlabel.Color:=clbtnface;
  if state=5 then freehandlabel.Color:=clbtnface;
  if state=7 then grablabel.Color:=clbtnface;
  if state=9 then sizelabel.Color:=clbtnface;
  if state=11 then begin
   selectlabel.Color:=clbtnface;
   if selectedobject<>nil then selectedobject.unselect;
   selectedobject:=nil;
   end;
  state:=0;
  end;
end;

procedure TForm1.ClearAllClick(Sender: TObject);
begin
 image1.canvas.pen.Color:=clwhite;
 image1.Canvas.Brush.Color:=clwhite;
 image1.Canvas.Rectangle(0,0,image1.width-1,image1.height-1);
 Objectlist.clear;
end;

procedure TForm1.ColorLabelClick(Sender: TObject);
begin
 if colordialog1.Execute then begin
  drawcolor:=colordialog1.Color;
  colorlabel.Color:=DrawColor;
  if state=11 then begin
   if SelectedObject is TGraphicLine then
    (SelectedObject as TGraphicLine).color:=DrawColor;
   if SelectedObject is TGraphicRect then
    (SelectedObject as TGraphicRect).color:=DrawColor;
   SelectedObject.redraw;
   end;
  end;
end;

end.

Feedback is welcome

sponsored links

Delphi
home

last updated: 23.june.03

Copyright (99,2003) Ing.Büro R.Tschaggelar