EBIDX is a shape-drawing application that uses the keyboard
exclusively. This is useful for drawing elipses, diamonds, rectangles,
circles, etc.
The (astonishingly) small size of this program means that I don't have
to bother posting the executable. I just post the instructions and
the source code. Others are encouraged to upgrade the project.
Usage
Creating shapes
p create ellipses
z create diamonds
+ create rectangles
r create rounded rectangles
* create circles
Moving shapes
Using the 19
keys on the numeric keypad. Num Lock must be on.
Resizing shapes
w make shape wider
n make shape more narrow
t make shape taller
s make shape shorter
Misc
d delete a shape
i change line width
c change color of shape
& change from solid to clear and vice versa
Notes
n and w resize circles. It shouldn't be necessary to use t and/or s.
Pressing i changes the value of the line width for shapes. Possible
values range from 1 to 16. Changes to line width are silent and
do not take effect on the shape you are editing (due to a bug.) The
next shape you create will use the new line width. Setting line width
to 17 will reset the linewidth to 1 again. All commands must be in
lowercase to be recognized. Typing in S instead of s won't produce
the desired outcome.
About
The author is Phil Sassano. The email for questions is
kingof...@hotmail.com. EBIDX is a Free Pascal app.
It requires only a window with a color dialog selection
component on it. The source code is only (roughly 300)
lines of code, but there is significant shapedrawing
power
stuffed in there :)
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls,
EditBtn;
type
{ TForm1 }
TForm1 = class(TForm)
ColorDialog1: TColorDialog;
procedure FormCreate(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X: LongInt; Y: LongInt);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
var
linewidth: integer;
linetype: integer;
solidstyle: boolean;
shape1: Tshape;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
// all this project requires is a form with a color selection
// dialog control on it.
form1.Canvas.AutoRedraw := true;
solidstyle := true;
linetype := 0;
linewidth := 1;
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = '&' then
begin
solidstyle := not solidstyle;
if linetype = 0 then exit;
if solidstyle = true then
shape1.brush.style := bssolid
else
shape1.brush.style := bsclear;
exit;
end;
if key = 'i' then
begin
linewidth := linewidth + 1;
if linewidth > 16 then linewidth := 1;
exit;
end;
if key = 'p' then
begin
shape1 := Tshape.Create(self);
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
linetype := 5;
shape1.pen.width := linewidth;
shape1.pen.color := shape1.Brush.Color;
shape1.shape := stEllipse;
shape1.parent := self;
shape1.Visible := true;
end;
if key='z' then
begin
shape1 := Tshape.Create(self);
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
linetype := 5;
shape1.pen.color := shape1.Brush.Color;
shape1.pen.width := linewidth;
shape1.shape := stDiamond;
shape1.Refresh;
shape1.parent := self;
shape1.Visible := true;
end;
if key='r' then
begin
shape1 := Tshape.Create(self);
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
linetype := 5;
shape1.pen.color := shape1.Brush.Color;
shape1.pen.width := linewidth;
shape1.shape := stRoundRect;
shape1.parent := self;
shape1.Visible := true;
end;
if key='*' then
begin
shape1 := Tshape.Create(self);
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
linetype := 2;
shape1.pen.color := shape1.Brush.Color;
shape1.pen.width := linewidth;
shape1.shape := stCircle;
shape1.parent := self;
shape1.Visible := true;
end;
if key='+' then
begin
shape1 := Tshape.Create(self);
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
linetype := 4;
shape1.pen.color := shape1.Brush.Color;
shape1.pen.width := linewidth;
shape1.shape := stRectangle;
shape1.parent := self;
shape1.Visible := true;
exit;
end;
if linetype = 0 then exit;
if solidstyle = true then
shape1.brush.Style := bsSolid
else
shape1.brush.style := bsClear;
if linetype = 4 then
begin
if key='w' then
begin
shape1.height := shape1.height + 1;
shape1.width := shape1.width + 1;
exit;
end;
if key='n' then
begin
shape1.height := shape1.height 1;
shape1.width := shape1.width 1;
exit;
end;
end;
if key = 'c' then
begin
if colordialog1.Execute = true then
begin
shape1.Brush.Color := colordialog1.Color;
shape1.Pen.Color := colordialog1.color;
end;
end;
if key = 'w' then
shape1.width := shape1.width + 1;
if key = 'n' then
shape1.width := shape1.width 1;
if key = 't' then
shape1.height := shape1.height + 1;
if key = 's' then
shape1.height := shape1.height 1;
if key = 'd' then
begin
shape1.free;
linetype := 0;
exit;
end;
if key = '1' then
begin
shape1.top := shape1.top + 1;
shape1.Left := shape1.left 1;
exit;
end;
if key = '3' then
begin
shape1.top := shape1.top + 1;
shape1.Left := shape1.left + 1;
exit;
end;
if key = '7' then
begin
shape1.top := shape1.top 1;
shape1.Left := shape1.left 1;
exit;
end;
if key = '9' then
begin
shape1.top := shape1.top 1;
shape1.Left := shape1.left + 1;
exit;
end;
if key = '8' then shape1.top := shape1.top 1;
if key = '2' then shape1.top := shape1.top + 1;
if key = '6' then shape1.left := shape1.left + 1;
if key = '4' then shape1.left := shape1.left 1;
shape1.pen.width := linewidth;
shape1.refresh;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X: LongInt; Y: LongInt);
begin
if linetype = 0 then exit;
shape1.left := x;
shape1.top := y;
end;
initialization
{$I unit1.lrs}
end.
--
You received this message because you are subscribed to the Linux Users Group.
To post a message, send email to linuxusersgroup@googlegroups.com
To unsubscribe, send email to linuxusersgroup-unsubscr...@googlegroups.com
For more options, visit our group at
http://groups.google.com/group/linuxusersgroup
