where : ibrtses delphi
Delphi - Graphic editor / take 1
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 has no memory, and no further editing capabilities beside :
- draw a line
- draw a rectangle
- draw free hand
- clear the lot
It is based on a TImage.
Plus, it shows the useage of rubber banding.
the code
unit Graphicstest1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ComCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
StatusBar1: TStatusBar;
GroupBox1: TGroupBox;
LineLabel: TLabel;
ColorLabel: TLabel;
RectLabel: TLabel;
PopupMenu1: TPopupMenu;
ClearAll: TMenuItem;
ColorDialog1: TColorDialog;
freehandlabel: 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);
private
{ Private declarations }
public
{ Public declarations }
lastx,lasty:integer;
startx,starty:integer;
state:integer;
DrawColor:TColor;
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;
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); // caption:='Line'
begin
state:=1;
rectlabel.Color:=clbtnface;
linelabel.Color:=clwhite;
freehandlabel.color:=clbtnface;
end;
procedure TForm1.RectLabelClick(Sender: TObject); // caption:='Rectangle'
begin
state:=3;
linelabel.Color:=clbtnface;
rectlabel.Color:=clwhite;
freehandlabel.color:=clbtnface;
end;
procedure TForm1.freehandlabelClick(Sender: TObject); // caption:='Freehand'
begin
state:=5;
linelabel.Color:=clbtnface;
rectlabel.Color:=clbtnface;
freehandlabel.color:=clwhite;
end;
procedure TForm1.ColorLabelClick(Sender: TObject); // caption:='Color'
begin
if colordialog1.Execute then begin
drawcolor:=colordialog1.Color;
colorlabel.Color:=DrawColor;
end;
end;
// starts selected drawing action
//
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
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;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var p:TGraphicBase;
begin
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;
statusbar1.Panels[0].Text:='mouse '+inttostr(x)+' '+inttostr(y);
end;
// ends current drawing action
//
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var Line:TGraphicLine;
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;
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;
end;
if state=6 then begin // freehand mode - end
state:=5;
end;
end;
// Since the image cannot receive keys, set form.keypreview:=true
//
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=$1B then begin // ESC
if state=1 then linelabel.Color:=clbtnface;
if state=3 then rectlabel.Color:=clbtnface;
if state=5 then freehandlabel.Color:=clbtnface;
state:=0;
end;
end;
procedure TForm1.ClearAllClick(Sender: TObject); // popup menu choice
begin
image1.canvas.pen.Color:=clwhite;
image1.Canvas.Brush.Color:=clwhite;
image1.Canvas.Rectangle(0,0,image1.width-1,image1.height-1);
end;
end.
Feedback is welcome
sponsored links
Delphi
home
last updated: 21.june.03
Copyright (99,2003) Ing.Büro R.Tschaggelar