unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,StdCtrls, ExtCtrls;
type
{ TForm1 }
TForm1 =
class(TForm)
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
RadioGroup1: TRadioGroup;
Button1: TButton;
RadioGroup2: TRadioGroup;
SaveDialog1: TSaveDialog;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1 : TForm1;
Stiftzustand,
Koordinaten,
xglob,
yglob,
xold,
yold,
h,
w : integer;
o_string,
dateiname :
string;
f : textfile;
dateioffen : boolean;
implementation
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
// Koordinatenanzeige in Labels
begin
label1.Caption:='
x= '+inttostr(x);
label2.Caption:='
y= '+inttostr(y);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
h:=image1.Height;
// Höhe des Bildes zwischenspeichern
w:=image1.Width;
// Breite des Bildes zwischenspeichern
image1.Canvas.Brush.Color:=clwhite;
// Farbe zum Löschen setzen
image1.Canvas.FillRect(rect(0,0,w,h));
// Löschen
image1.Cursor:=crcross;
dateiname:='
default.txt';
xold:=0;
yold:=0;
dateioffen:=false;
button3.Enabled:=false;
end;
procedure TForm1.Button1Click(Sender: TObject);
// "Punkt speichern"
procedure absolut;
// Absolut - Punkt anfahren
begin
o_string:='
X'+inttostr(xglob);
o_string:=o_string+'
Y'+inttostr(yglob);
end;
procedure relativ;
// Realtiv - Punkt anfahren
begin
o_string:='
DELTAX'+inttostr(xglob-xold);
o_string:=o_string+'
DELTAY'+inttostr(yglob-yold);
end;
begin
Stiftzustand:=radiogroup1.ItemIndex;
// Stiftzustand wählen
Koordinaten:=radiogroup2.ItemIndex;
// Koordinatenart wählen
case Koordinaten
of
0: absolut;
1: relativ;
end;
// o_string:=o_string+'HF'+inttostr(stiftzustand); ????
case stiftzustand
of
0:
begin // HF0 - Eilgang
image1.Canvas.Pen.Style := psDot;
image1.Canvas.Pen.Color:=clred;
image1.Canvas.LineTo(xglob,yglob);
end;
1:
begin // HF1 - Schneiden
image1.Canvas.Pen.Style := psSolid;
image1.Canvas.Pen.Color:=clblack;
image1.Canvas.LineTo(xglob,yglob);
end;
2:
begin // HF2 - Koernern
image1.Canvas.Pen.Style := psdashdot;
image1.Canvas.Pen.Color:=clblue;
image1.Canvas.LineTo(xglob,yglob);
end;
3:
begin // HF3 - Markieren
image1.Canvas.Pen.Style := psdash;
image1.Canvas.Pen.Color:=clgreen;
image1.Canvas.LineTo(xglob,yglob);
end;
else
showmessage('
erst Werkzeug wählen!');
exit;
end;
xold:=xglob;
yold:=yglob;
if dateioffen
then
begin
writeln(f,o_string);
end
else
begin
showmessage('
Datei nicht offen '+o_string);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
// "Datei" speichern
begin
if savedialog1.execute
then
begin
dateiname:=savedialog1.filename;
end
else
dateiname:='
default.txt';
assignfile(f,dateiname);
rewrite(f);
dateioffen:=true;
button2.Enabled:=false;
button3.Enabled:=true;
button4.Enabled:=false;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
xglob:=x;
yglob:=y;
end;
procedure TForm1.Button3Click(Sender: TObject);
// "Datei schließen"
begin
if dateioffen
then
begin
dateioffen:=false;
closefile(f);
button2.Enabled:=true;
button3.Enabled:=false;
button4.Enabled:=true;
end
else
showmessage('
Datei ist nicht geöffnet, kann also nicht geschlossen werden');
end;
procedure TForm1.Button4Click(Sender: TObject);
// "Prgm beenden"
begin
close;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
Var o_string:
string;
begin
o_string:='
HF'+inttostr(RadioGroup1.itemindex);
if dateioffen
then
begin
writeln(f,o_string);
end
else
begin
showmessage('
Datei nicht offen '+O_string);
end;
end;
initialization
{$I unit1.lrs}
end.