Folge dem Video um zu sehen, wie unsere Website als Web-App auf dem Startbildschirm installiert werden kann.
Anmerkung: Diese Funktion ist in einigen Browsern möglicherweise nicht verfügbar.
unit startunit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
PaintBox1: TPaintBox;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
Shape1: TShape;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
TPlatine = class(TPaintBox)
protected
procedure Paint; override;
public
ngrid: integer;
abbild: TBitmap;
abstream: TMemoryStream;
constructor create(aowner: TComponent); override;
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Mup (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
end;
TBauteileEnum = ( Batterie_Typ
);
// --------------------------
TLeitungsDraht = class;
TAnkerMove = class(TShape)
public
drag: boolean;
FLeitung: TLeitungsDraht;
FVerdratetMit: TLeitungsDraht;
constructor create(aowner: TComponent); override;
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Mup (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MMove(Sender: TObject; Shift : TShiftState; X, Y: Integer);
end;
TLeitungsDraht = class(TShape)
public
AnkerLinks : TAnkerMove;
AnkerRechts: TAnkerMove;
p0: TPoint;
p1: TPoint;
constructor create(aowner: TComponent); override;
end;
// --------------------------
TBauteil = class(TPaintBox)
protected
procedure Paint; override;
public
drag: Boolean;
name: String;
BauteilArt: TBauteileEnum;
FPlusLine : TLeitungsDraht;
FMinusLine: TLeitungsDraht;
constructor create(aowner: TComponent); override;
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Mup (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MMove(Sender: TObject; Shift : TShiftState; X, Y: Integer);
end;
TBauteilBatterie = class(TBauteil)
protected
procedure Paint; override;
public
constructor create(aowner: TComponent); override;
end;
var
Form1: TForm1;
state: byte;
p0,p1,p2: TPoint;
implementation
{$R *.dfm}
var
FLeitungVerlegen: Boolean;
FNeuesKabel: Boolean;
FKabelAndocken: Boolean;
FPlatineID: TPlatine;
FPlatinenBauteil: Array [0..1] of TBauteilBatterie;
FLeitungen: Array [0..20] of TLeitungsDraht;
constructor TPlatine.create(Aowner: TComponent);
begin
inherited create(aowner);
Parent := form1.ScrollBox1;
ngrid := 10;
width := form1.ScrollBox1.Width;
height := form1.ScrollBox1.height;
left := form1.ScrollBox1.left - (ngrid * 2);
top := form1.ScrollBox1.top - (ngrid * 2);
onMouseUp := Mup;
onMouseDown := MDown;
Visible := true;
end;
procedure TPlatine.Mup(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FNeuesKabel := false;
FKabelAndocken := false;
end;
procedure TPlatine.MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FNeuesKabel then
begin
p0.X := x; p1.X := x;
p0.y := y; p1.Y := y + 40;
FLeitungen[0] := TLeitungsDraht.create(TComponent(Sender));
FLeitungen[0].Parent := form1.ScrollBox1;
FLeitungen[0].AnkerLinks .FLeitung := FLeitungen[0];
FLeitungen[0].AnkerRechts.FLeitung := FLeitungen[0];
FLeitungen[0].AnkerLinks.Left := p0.x;
FLeitungen[0].AnkerLinks.top := p0.y;
FLeitungen[0].AnkerRechts.Left := p1.x;
FLeitungen[0].AnkerRechts.top := p1.y;
FLeitungen[0].AnkerLinks. visible := true;
FLeitungen[0].AnkerRechts.visible := true;
FLeitungen[0].top := p0.Y + 10;
FLeitungen[0].left := p1.X + 5;
FLeitungen[0].height := p1.y - p0.Y - 8;
FLeitungen[0].visible := true;
exit;
end;
end;
procedure TPlatine.Paint;
var
i, j : integer;
begin
i := 0;
j := 0;
while i <= Height do
begin
while j <= Width do
begin
Canvas.Pixels[j, i] := clBlack;
j := j + ngrid; end;
i := i + ngrid;
j := 0;
end;
end;
constructor TAnkerMove.create(aowner: TComponent);
begin
inherited create(aowner);
onMouseDown := MDown;
onMouseUp := Mup;
onMouseMove := MMove;
end;
procedure TAnkerMove.MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
r: TRect;
begin
drag := true;
if assigned(FVerdratetMit) then
begin
FVerdratetMit.AnkerLinks.drag := true;
exit;
end;
if FKabelAndocken then
begin
r.Left := 0; r.Right := r.left + 30;
r.Top := 0; r.Bottom := r.top + 20;
if (x >= r.left) and (x <= r.Right) and
(y >= r.Top ) and (y <= r.Bottom)
then begin
FLeitungen[1] := TLeitungsDraht.create(TComponent(Sender));
FLeitungen[1].Parent := form1.ScrollBox1;
FLeitungen[1].width := 50;
FLeitungen[1].height := 2;
FLeitungen[1].top := top + 5;
FLeitungen[1].left := left + 8;
FLeitungen[1].visible := true;
FLeitung := FLeitungen[1];
FVerdratetMit := TLeitungsDraht.create(TComponent(Sender));
FVerdratetMit.Parent := form1.ScrollBox1;
FVerdratetMit.AnkerRechts := TAnkerMove.create(TControl(Sender));
FVerdratetMit.AnkerRechts.Parent := form1.ScrollBox1;
FVerdratetMit.AnkerRechts.Top := FLeitungen[1].top - 5;
FVerdratetMit.AnkerRechts.left := FLeitungen[1].left + 50;
FVerdratetMit.AnkerRechts.width := 12;
FVerdratetMit.AnkerRechts.height := 10;
FVerdratetMit.AnkerRechts.Shape := stCircle;
FVerdratetMit.AnkerRechts.Visible := true;
FVerdratetMit.AnkerLinks := TAnkerMove.create(TControl(Sender));
FVerdratetMit.AnkerLinks.Parent := form1.ScrollBox1;
FVerdratetMit.AnkerLinks.Top := FLeitungen[1].top - 3;
FVerdratetMit.AnkerLinks.left := FLeitungen[1].left - 10;
FVerdratetMit.AnkerLinks.width := 12;
FVerdratetMit.AnkerLinks.height := 10;
FVerdratetMit.AnkerLinks.Shape := stCircle;
FVerdratetMit.AnkerLinks.Visible := true;
FKabelAndocken := false;
end;
end;
end;
procedure TAnkerMove.Mup(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
drag := false;
end;
procedure TAnkerMove.MMove(Sender: TObject; Shift : TShiftState; X, Y: Integer);
var
p0: Tpoint;
begin
if not drag then exit;
{panel coordiantes to global form coordinates}
x := left + x;
y := top + y;
{calculate matching grid position}
x := (x div FPlatineID.ngrid) * FPlatineID.ngrid;
y := (y div FPlatineID.ngrid) * FPlatineID.ngrid;
p0.y := top;
{move the panel there}
left := x;
top := y;
if Assigned(FVerdratetMit) then
begin
if not Assigned(FVerdratetMit.AnkerLinks) then exit;
if not FVerdratetMit.AnkerLinks.drag then exit;
FVerdratetMit.AnkerLinks.left := left + 5;
FVerdratetMit.AnkerLinks.top := p0.y + 10;
FVerdratetMit.AnkerLinks.height := FVerdratetMit.AnkerLinks.top - FVerdratetMit.AnkerLinks.top;
FVerdratetMit.AnkerLinks.Left := left;
if assigned(FVerdratetMit) then
begin
FVerdratetMit.Left := left + 5;
FVerdratetMit.Top := top + 3;
end;
end else
if Assigned(FLeitung) then
begin
if not Assigned(FLeitung.AnkerLinks) then exit;
if not FLeitung.AnkerLinks.drag then exit;
FLeitung.left := left + 5;
FLeitung.top := top + 10;
FLeitung.height := FLeitung.AnkerRechts.top - FLeitung.top;
FLeitung.AnkerRechts.Left := left;
if assigned(FVerdratetMit) then
begin
FVerdratetMit.Left := left + 8;
FVerdratetMit.Top := top + 3;
end;
end else
if Assigned(FLeitung) then
begin
if not Assigned(FLeitung.AnkerRechts) then exit;
if not FLeitung.AnkerRechts.drag then exit;
FLeitung.left := left + 5;
FLeitung.top := p0.y + 10;
FLeitung.height := FLeitung.AnkerLinks.top - FLeitung.top;
FLeitung.AnkerLinks.Left := left;
end;
end;
constructor TLeitungsDraht.create(aowner: TComponent);
begin
inherited create(aowner);
width := 2;
AnkerLinks := TAnkerMove.Create(aowner);
AnkerLinks.Parent := form1.ScrollBox1;
AnkerLinks.Shape := stCircle;
AnkerLinks.Visible := false;
AnkerLinks.Height := 12;
AnkerLinks.Width := 10;
AnkerRechts := TAnkerMove.Create(aowner);
AnkerRechts.Parent := form1.ScrollBox1;
AnkerRechts.Shape := stCircle;
AnkerRechts.Visible := false;
AnkerRechts.Height := 12;
AnkerRechts.Width := 10;
end;
constructor TBauteilBatterie.create(aowner: TComponent);
begin
inherited create(aowner);
Parent := Form1.ScrollBox1;
BauteilArt := Batterie_Typ;
end;
procedure TBauteilBatterie.Paint;
begin
inherited paint;
with canvas do
begin
brush.color := clolive;
FillRect(Rect(0,20,width,height));
Pen.Width := 2;
moveto(10,20); LineTo(10,10);
moveto(30,20); lineto(30,10);
brush.color := clwhite;
ellipse(5, 5,15,15);
ellipse(25,5,35,15);
brush.color := clgreen;
font.Size := 12;
font.Name := 'Arial';
font.Style := [fsbold];
font.Color := clwhite;
TextOut(8 ,20,'-');
TextOut(24,22,'+');
end;
end;
procedure TBauteil.MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
visible := false;
FPlatineID.abbild := TBitmap.Create;
FPlatineID.abstream := TMemoryStream.Create;
FPlatineID.abbild.SaveToStream(FPlatineID.abstream);
visible := true;
drag := true;
form1.label1.caption := name;
(*
if BauteilArt = Batterie_typ then
begin
if (((x >= 0) and (x <= 13)) and ((y >= 0) and (y <= 15))) then
begin
FLeitungVerlegen := true;
FMinusLine.LeitungVerdrahtet := true;
FMinusLine.x_pos := x;
FMinusLine.y_pos := y;
MMove(Sender,Shift,x,y);
end;
end;
*)
end;
procedure TBauteil.Mup(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FPlatineID.abbild.FreeImage;
FPlatineID.abbild.Free;
drag := false;
FLeitungVerlegen := false;
(*
if FMinusLine.LeitungVerdrahtet then
begin
if BauteilArt = Batterie_Typ then
begin
if ((FMinusLine.x_pos >= 0) and (FMinusLine.x_pos <= 13)) and
((FMinusLine.y_pos >= 0) and (FMinusLine.y_pos <= 13))
then begin
FMinusLine.left := left + 9;
FMinusLine.top := top - 15;
if FMinusLine.AnkerLinks.drag then
begin
FMinusLine.AnkerLinks.Top := FMinusLine.top - 10;
FMinusLine.AnkerLinks.left := FMinusLine.left - 5;
end;
FMinusLine.AnkerLinks.Visible := true;
end;
end;
end;
*)
end;
procedure TBauteil.MMove(Sender: TObject; Shift : TShiftState; X, Y: Integer);
begin
if not drag then exit;
FPlatineID.abbild.LoadFromStream(FPlatineID.abstream);
FPlatineID.Canvas.Draw(0,0,FPlatineID.abbild);
{panel coordiantes to global form coordinates}
if FLeitungVerlegen then
begin
FMinusLine.top := top ;
FMinusLine.left := left - 10;
FMinusLine.height := 20;
y := FMinusLine.top + y;
x := FMinusLine.left + x;
FMinusLine.Visible := true;
end else begin
x := left + x;
y := top + y;
end;
{calculate matching grid position}
x := (x div FPlatineID.ngrid) * FPlatineID.ngrid;
y := (y div FPlatineID.ngrid) * FPlatineID.ngrid;
{move the panel there}
if FLeitungVerlegen then
begin
FMinusLine.top := y;
FMinusLine.left := x;
end else begin
left := x;
top := y;
end;
(*
if FMinusLine.LeitungVerdrahtet then
begin
if BauteilArt = Batterie_Typ then
begin
if ((FMinusLine.x_pos >= 0) and (FMinusLine.x_pos <= 13)) and
((FMinusLine.y_pos >= 0) and (FMinusLine.y_pos <= 13))
then begin
//if FMinusLine.AnkerLinks.drag then
begin
FMinusLine.AnkerLinks.Top := y - 25;
FMinusLine.AnkerLinks.left := x + 5;
end;
FMinusLine.left := x + 10;
FMinusLine.top := y - 10;
FMinusLine.AnkerLinks.Visible := true;
end;
end;
end;
*)
end;
procedure TBauteil.Paint;
begin
// inherited paint;
end;
constructor TBauteil.create(aowner: TComponent);
begin
if not Assigned(FPlatineID) then
FPlatineID := TPlatine.create(aowner);
inherited create(aowner);
Parent := Form1.ScrollBox1;
FPlusLine := TLeitungsDraht.Create(aowner); FPlusLine .Parent := Parent; FPlusLine .Visible := false;
FMinusLine := TLeitungsDraht.Create(aowner); FMinusLine.Parent := Parent; FMinusLine.Visible := false;
// FPlusLine .LeitungVerdrahtet := false;
// FMinusLine.LeitungVerdrahtet := false;
FMinusLine.Shape := stRoundRect;
FMinusLine.Width := 2;
onMouseDown := MDown;
onMouseUp := mup;
onMouseMove := MMove;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FPlatinenBauteil[0] := TBauteilBatterie.create(ScrollBox1);
FPlatinenBauteil[0].name := 'Batterie 1';
FPlatinenBauteil[0].Tag := 1;
FPlatinenBauteil[0].Top := 40;
FPlatinenBauteil[0].Left := 40;
FPlatinenBauteil[0].Width := 42;
FPlatinenBauteil[0].Height := 40;
//
FPlatinenBauteil[1] := TBauteilBatterie.create(ScrollBox1);
FPlatinenBauteil[1].name := 'Batterie 2';
FPlatinenBauteil[1].Tag := 2;
FPlatinenBauteil[1].Top := 40;
FPlatinenBauteil[1].Left := 200;
FPlatinenBauteil[1].Width := 42;
FPlatinenBauteil[1].Height := 40;
state := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FNeuesKabel := true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FKabelAndocken := true;
end;
end.