diff --git a/components/jvcllaz/design/JvJans/images/images.txt b/components/jvcllaz/design/JvJans/images/images.txt
index f0bf3116e..b2519e069 100644
--- a/components/jvcllaz/design/JvJans/images/images.txt
+++ b/components/jvcllaz/design/JvJans/images/images.txt
@@ -9,5 +9,7 @@ tjvsimbutton.bmp
tjvsimreverse.bmp
tjvsimlight.bmp
tjvlogic.bmp
+tjvjanled.bmp
+tjvjantoggle.bmp
tjvmarkupviewer.bmp
tjvmarkuplabel.bmp
diff --git a/components/jvcllaz/design/JvJans/images/tjvjanled.bmp b/components/jvcllaz/design/JvJans/images/tjvjanled.bmp
new file mode 100644
index 000000000..9b8aef208
Binary files /dev/null and b/components/jvcllaz/design/JvJans/images/tjvjanled.bmp differ
diff --git a/components/jvcllaz/design/JvJans/images/tjvjantoggle.bmp b/components/jvcllaz/design/JvJans/images/tjvjantoggle.bmp
new file mode 100644
index 000000000..7cd22b05d
Binary files /dev/null and b/components/jvcllaz/design/JvJans/images/tjvjantoggle.bmp differ
diff --git a/components/jvcllaz/design/JvJans/images/tjvmarkuplabel.bmp b/components/jvcllaz/design/JvJans/images/tjvmarkuplabel.bmp
new file mode 100644
index 000000000..924119236
Binary files /dev/null and b/components/jvcllaz/design/JvJans/images/tjvmarkuplabel.bmp differ
diff --git a/components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp b/components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp
new file mode 100644
index 000000000..2c6fc5e27
Binary files /dev/null and b/components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp differ
diff --git a/components/jvcllaz/design/JvJans/jvjansreg.pas b/components/jvcllaz/design/JvJans/jvjansreg.pas
index bdbff5fd9..e7e05b243 100644
--- a/components/jvcllaz/design/JvJans/jvjansreg.pas
+++ b/components/jvcllaz/design/JvJans/jvjansreg.pas
@@ -18,7 +18,8 @@ uses
JvYearGrid,
//JvCSVData, JvCSVBaseControls, //JvCsvBaseEditor,
JvMarkupViewer, JvMarkupLabel,
- JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic;
+ JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic,
+ JvJanLed, JvJanToggle;
procedure Register;
begin
@@ -30,7 +31,9 @@ begin
RegisterComponents(RsPaletteJvcl, [ // was: RsPaletteJansSim
TJvSimScope, TJvSimIndicator, TJvSimPID,
TJvSimPIDLinker, TJvSimConnector, TJvLogic, TJvSimButton, TJvSimLight,
- TJvSimLogicBox, TJvSimReverse]);
+ TJvSimLogicBox, TJvSimReverse,
+ TJvJanLed, TJvJanToggle
+ ]);
// Markup components
RegisterComponents(RsPaletteJvcl, [
diff --git a/components/jvcllaz/packages/jvjanslazr.lpk b/components/jvcllaz/packages/jvjanslazr.lpk
index d862acfab..2d6b0124d 100644
--- a/components/jvcllaz/packages/jvjanslazr.lpk
+++ b/components/jvcllaz/packages/jvjanslazr.lpk
@@ -17,7 +17,7 @@
- Simulation components"/>
-
+
@@ -58,6 +58,14 @@
+
+
+
+
+
+
+
+
diff --git a/components/jvcllaz/resource/jvjansreg.res b/components/jvcllaz/resource/jvjansreg.res
index a8be459a3..51112dcd5 100644
Binary files a/components/jvcllaz/resource/jvjansreg.res and b/components/jvcllaz/resource/jvjansreg.res differ
diff --git a/components/jvcllaz/run/JvJans/jvjanled.pas b/components/jvcllaz/run/JvJans/jvjanled.pas
new file mode 100644
index 000000000..684174177
--- /dev/null
+++ b/components/jvcllaz/run/JvJans/jvjanled.pas
@@ -0,0 +1,124 @@
+unit JvJanLed;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons;
+
+type
+ TLedColor = (lcRed, lcGreen, lcYellow, lcBlue, lcPurple);
+
+ TJvJanLed = class(TGraphicControl)
+ private
+ { Private declarations }
+ FLit: boolean;
+ FLedColor: TLedColor;
+ procedure SetLit(const AValue: boolean);
+ procedure SetLedColor(const AValue: TLedColor);
+ {
+ procedure KeepSize(Sender: TObject; var ANewWidth, ANewHeight: Integer;
+ var AResize: Boolean); }
+
+ protected
+ { Protected declarations }
+ procedure Paint; override;
+
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ published
+ { Published declarations }
+ property Lit: boolean read FLit write SetLit default false;
+ property LedColor: TLedColor read FLedColor write SetLedColor default lcRed;
+ end;
+
+
+implementation
+
+
+{ TJvJanLed }
+
+constructor TJvJanLed.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle + [csReplicatable];
+ Width := 12;
+ Height := 13;
+ FLit := false;
+ FLedColor := lcRed;
+ {OnCanResize := @KeepSize;}
+end;
+
+destructor TJvJanLed.Destroy;
+begin
+ //mycode
+ inherited Destroy;
+end;
+
+procedure TJvJanLed.Paint;
+var
+ surfCol, litCol: TColor;
+begin
+ if Flit then begin
+ case FLedColor of
+ lcRed: begin surfCol := clRed; litCol := clWhite; end;
+ lcGreen: begin surfCol := clLime; litCol := clWhite; end;
+ lcYellow: begin surfCol := clYellow; litCol := clWhite; end;
+ lcBlue: begin surfCol := clAqua; litCol := clWhite; end;
+ lcPurple: begin surfCol:= clFuchsia; litCol := clWhite; end;
+ end;
+ end
+ else begin
+ case FLedColor of
+ lcRed: begin surfCol := clMaroon; litCol := clred; end;
+ lcGreen: begin surfCol := clGreen; litCol := clLime; end;
+ lcYellow: begin surfCol := clOlive; litCol := clYellow; end;
+ lcBlue: begin surfCol := clNavy; litCol := clAqua; end;
+ lcPurple: begin surfCol := clPurple; litCol := clFuchsia; end;
+ end;
+ end;
+ with Canvas do begin
+ Brush.Color := clsilver;
+ FillRect(0, 0, 12, 13);
+ Brush.Style := bsClear;
+ Pen.Color := clGray;
+ Ellipse(0, 0, 12, 13);
+ Pen.Color := clBlack;
+ Brush.Color := surfCol;
+ Ellipse(1, 1, 11, 12);
+ Pen.Color := clWhite;
+ Arc(1, 1, 11, 12, 0, 12, 12, 0);
+ Pen.Color := litCol;
+ Arc(3, 3, 8, 9, 5, 0, 0, 8);
+ end;
+end;
+ {
+procedure TJvJanLed.KeepSize(Sender: TObject; var ANewWidth, ANewHeight: Integer;
+ var AResize: Boolean);
+begin
+ AResize := True;
+ ANewWidth := Width;
+ ANewHeight := Height;
+end; }
+
+procedure TJvJanLed.SetLit(const AValue: boolean);
+begin
+ if AValue <> FLit then begin
+ FLit := AValue;
+ Refresh;
+ end;
+end;
+
+procedure TJvJanLed.SetLedColor(const AValue: TLedColor);
+begin
+ if AValue <> FLedColor then begin
+ FLedColor := AValue;
+ Refresh;
+ end;
+end;
+
+end.
diff --git a/components/jvcllaz/run/JvJans/jvjantoggle.pas b/components/jvcllaz/run/JvJans/jvjantoggle.pas
new file mode 100644
index 000000000..a011bdf6d
--- /dev/null
+++ b/components/jvcllaz/run/JvJans/jvjantoggle.pas
@@ -0,0 +1,397 @@
+unit JvJanToggle;
+
+interface
+
+uses
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons;
+
+type
+ TOnToggleChange = procedure (Sender: Tobject; AState: boolean) of object;
+
+ TToggleColor = (tcRed, tcGreen, tcYellow, tcBlue, tcPurple);
+ TToggleStyle = (tsVertical, tsHorizontal);
+ TButtonStyle = (bsSquare, bsRound);
+
+ TJvJanToggle = class(TGraphicControl)
+ private
+ FOnToggleChange: TOnToggleChange;
+ FToggleState: boolean;
+ FIn, FOut: TRect;
+ FInColor: TToggleColor;
+ FOutColor: TToggleColor;
+ FBackLit: boolean;
+ FMarking: boolean;
+ FToggleStyle: TToggleStyle;
+ FInCap: string;
+ FOutCap: string;
+ FButtonStyle: TButtonStyle;
+ procedure DoToggleChange;
+ procedure SetToggleState(const AValue: boolean);
+{ procedure keepsize(Sender: TObject);}
+ procedure SetIncolor(const AValue: TToggleColor);
+ procedure SetOutColor(const AValue: TToggleColor);
+ procedure SetBackLit(const AValue: boolean);
+ function FXcolor(AColor: TToggleColor; ABright: boolean): TColor;
+ procedure SetMarking(const AValue: boolean);
+ procedure SetToggleStyle(const AValue: TToggleStyle);
+ procedure MakeStyle;
+ procedure SetInCap(const AValue: string);
+ procedure SetOutCap(const AValue: string);
+ procedure SetButtonStyle(const AValue: TButtonStyle);
+
+ protected
+ procedure Paint; override;
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ToggleMouseDown(Sender: TObject; AButton: TMouseButton;
+ AShift: TShiftState; X, Y: Integer);
+
+ published
+ property ToggleState: Boolean read FToggleState write SetToggleState;
+ property ToggleStyle: TToggleStyle read FToggleStyle write SetToggleStyle;
+ property ButtonStyle: TButtonStyle read FButtonstyle
+ write SetButtonstyle default bsSquare;
+ property BackLit: boolean read FBackLit write SetBackLit default false;
+ property Marking: boolean read FMarking write SetMarking default true;
+ property InColor: TToggleColor read FInColor write SetInColor default tcRed;
+ property InCap: string read FInCap write SetInCap;
+ property OutColor: TToggleColor read FOutColor write SetOutColor default tcGreen;
+ property OutCap: string read FOutCap write SetOutCap;
+
+ property OnToggleChange: TOnToggleChange read FOnToggleChange write FOnToggleChange;
+ end;
+
+
+implementation
+
+{ TJvJanToggle }
+
+constructor TJvJanToggle.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle + [csReplicatable];
+ FButtonStyle := bsSquare;
+ MakeStyle;
+ OnMouseDown := @ToggleMouseDown;
+// onresize:=keepsize;
+ FInColor := tcRed;
+ FoutColor := tcGreen;
+ FBackLit := false;
+ FMarking := true;
+ FInCap := 'I';
+ FOutCap := 'O';
+end;
+
+
+destructor TJvJanToggle.Destroy;
+begin
+ //mycode
+ inherited Destroy;
+end;
+
+procedure TJvJanToggle.MakeStyle;
+begin
+ case FToggleStyle of
+ tsVertical:
+ begin
+ Width := 24;
+ Height := 48;
+ FIn := Rect(1, 1, Width-1, Width-2);
+ FOut := Rect(1, Width, Width-2, Height-2);
+ end;
+ tsHorizontal:
+ begin
+ Width := 48;
+ Height := 24;
+ FIn := Rect(1, 1, Height-2, Height-2);
+ FOut := Rect(Height, 1, Width-2, Height-2);
+ end;
+ end;
+ Refresh;
+end;
+
+procedure TJvJanToggle.DoToggleChange;
+begin
+ if Assigned(FOnToggleChange) then
+ FOnToggleChange(self, FToggleState);
+end;
+
+procedure TJvJanToggle.ToggleMouseDown(Sender: TObject; AButton: TMouseButton;
+ AShift: TShiftState; X, Y: Integer);
+var
+ hit, lState: boolean;
+
+ function InRect(x, y: Integer; ARect: TRect): boolean;
+ begin
+ Result := (x > ARect.Left) and
+ (x < ARect.Right) and
+ (y > ARect.Top) and
+ (y < ARect.Bottom);
+ end;
+
+begin
+ hit := false;
+ if InRect(x, y, FIn) then begin
+ hit := true;
+ lState := true;
+ end
+ else if InRect(x, y, FOut) then begin
+ hit := true;
+ lState := false;
+ end;
+ if hit then
+ ToggleState := lState;
+end;
+
+function TJvJanToggle.FXcolor(AColor: TToggleColor; ABright: boolean): TColor;
+begin
+ if ABright then
+ case AColor of
+ tcRed: Result := clRed;
+ tcGreen: Result := clLime;
+ tcYellow: Result := clYellow;
+ tcBlue: Result := clAqua;
+ tcPurple: Result := clFuchsia;
+ end
+ else
+ case AColor of
+ tcRed: Result := clMaroon;
+ tcGreen: Result := clGreen;
+ tcYellow: Result := clOlive;
+ tcBlue: Result := clNavy;
+ tcPurple: Result := clPurple;
+ end;
+end;
+
+procedure TJvJanToggle.Paint;
+
+ procedure DoLit(ARect: TRect; AColor: TToggleColor; ABright: boolean);
+ var
+ glass: TColor;
+ mr: integer;
+ x1, y1, x2, y2: integer;
+ begin
+ x1 := ARect.Left;
+ y1 := ARect.Top;
+ x2 := ARect.Right;
+ y2 := ARect.Bottom;
+ glass := FXColor(AColor, ABright);
+ mr := 1;
+ with Canvas do begin
+ Pen.Style := psClear;
+ Brush.Color := glass;
+ case FButtonStyle of
+ bsSquare: Rectangle(x1+mr, y1+mr, x2, y2);
+ bsRound: Ellipse(x1+2, y1+2, x2-2, y2-2);
+ end;
+ Pen.Style := psSolid;
+ if ABright then
+ Pen.Color := clWhite
+ else
+ Pen.Color := FXColor(AColor, true);
+ Arc(ARect.Left+3, ARect.Top+3, ARect.Right-3, ARect.Bottom-3,
+ ARect.Left+12,ARect.Top+0, ARect.Left+0, ARect.Top+16
+ );
+ Pen.Color := clBlack;
+ end;
+ end;
+
+ procedure BtnCap(R: TRect; s: string; AColor: TToggleColor; ABright: boolean);
+ var
+ x, y, w, h: integer;
+ begin
+ with Canvas do begin
+ w := TextWidth(s);
+ h := TextHeight(s);
+ x := (R.Right - R.Left - w + 1) div 2;
+ y := (R.Bottom - R.Top - h) div 2;
+ Font.Style := Font.Style + [fsBold];
+ Pen.Color := clBlack;
+ Brush.Style := bsClear;
+ if FBacklit then
+ Font.Color := clBlack
+ else
+ Font.Color := FXColor(AColor, ABright);
+ TextOut(R.Left + x, R.Top + y, s);
+ end;
+ end;
+
+ procedure BtnDown(ARect: TRect; s: string; AColor: TToggleColor);
+ var
+ x1, y1, x2, y2: integer;
+ begin
+ x1 := ARect.Left;
+ y1 := ARect.Top;
+ x2 := ARect.Right;
+ y2 := ARect.Bottom;
+ with Canvas do begin
+ case FButtonStyle of
+ bsSquare:
+ begin
+ Brush.Color := $E0E0E0;
+ FillRect(ARect);
+ Pen.Color := clBlack;
+ MoveTo(x1, y2);
+ LineTo(x1, y1);
+ LineTo(x2, y1);
+ Pen.Color := clWhite;
+ LineTo(x2, y2);
+ LineTo(x1, y2);
+ end;
+ bsRound:
+ begin
+ Brush.Color := $E0E0E0;
+ Pen.Color := clGray;
+ Ellipse(x1, y1, x2, y2);
+ Pen.Color := clBlack;
+ Ellipse(x1+1, y1+1, x2-1, y2-1);
+ Pen.Color := clWhite;
+ Arc(x1+1, y1+1, x2-1, y2-1, x1, y2, x2, y1);
+ end;
+ end;
+ if FBackLit then DoLit(ARect, AColor, true);
+ if FMarking then BtnCap(ARect, s, AColor, true);
+ end;
+ end;
+
+ procedure BtnUp(ARect: TRect; s: string; AColor: TTogglecolor);
+ var
+ x1, y1, x2, y2: integer;
+ begin
+ x1 := ARect.Left;
+ y1 := ARect.Top;
+ x2 := ARect.Right;
+ y2 := ARect.Bottom;
+ with Canvas do begin
+ case FButtonStyle of
+ bsSquare:
+ begin
+ Brush.Color := clSilver;
+ FillRect(arect);
+ Pen.Color := clWhite;
+ MoveTo(ARect.Left, ARect.Bottom);
+ LineTo(ARect.Left, ARect.Top);
+ LineTo(ARect.Right, ARect.Top);
+ Pen.Color := clBlack;
+ LineTo(ARect.Right, ARect.Bottom);
+ LineTo(ARect.Left, ARect.Bottom);
+ end;
+ bsRound:
+ begin
+ Brush.Color := clSilver;
+ Pen.Color := clGray;
+ Ellipse(x1, y1, x2, y2);
+ Pen.Color := clBlack;
+ Ellipse(x1+1, y1+1, x2-1, y2-1);
+ Pen.Color := clWhite;
+ Arc(x1+1, y1+1, x2-1, y2-1, x2, y1, x1, y2);
+ end;
+ end;
+ if FBackLit then DoLit(ARect, AColor, false);
+ if FMarking then btncap(ARect, s, AColor, false);
+ end;
+ end;
+
+begin
+ with Canvas do begin
+ Brush.Color := clSilver;
+ Pen.Color := clBlack;
+ case FButtonstyle of
+ bssquare: Rectangle(0, 0, Width, Height);
+ end;
+ if FToggleState then begin
+ BtnDown(FIn, FInCap, FInColor);
+ BtnUp(FOut, FOutCap, FOutColor);
+ end
+ else begin
+ BtnUp(FIn, FInCap, FInColor);
+ BtnDown(FOut, FOutCap, FOutColor);
+ end;
+ end;
+end;
+
+procedure TJvJanToggle.SetToggleState(const AValue: boolean);
+begin
+ if AValue <> FToggleState then
+ begin
+ FToggleState := AValue;
+ Refresh;
+ DoToggleChange;
+ end;
+end;
+
+procedure TJvJanToggle.SetInColor(const AValue: TToggleColor);
+begin
+ if FInColor <> AValue then begin
+ FInColor := AValue;
+ Refresh;
+ end;
+end;
+
+procedure TJvJanToggle.SetOutColor(const AValue: TToggleColor);
+begin
+ if FOutColor <> AValue then begin
+ FOutColor := AValue;
+ Refresh;
+ end;
+end;
+
+procedure TJvJanToggle.SetBackLit(const AValue: boolean);
+begin
+ if AValue <> FBackLit then begin;
+ FBackLit := AValue;
+ Refresh;
+ end;
+end;
+
+procedure TJvJanToggle.SetMarking(const AValue: boolean);
+begin
+ if AValue <> FMarking then begin
+ FMarking := AValue;
+ Refresh;
+ end;
+end;
+
+{
+procedure TJvJanToggle.keepsize(Sender: TObject);
+begin
+ makestyle;
+end; }
+
+procedure TJvJanToggle.SetToggleStyle(const AValue: TToggleStyle);
+begin
+ if AValue <> FToggleStyle then begin
+ FToggleStyle := AValue;
+ MakeStyle;
+ end;
+end;
+
+procedure TJvJanToggle.SetInCap(const AValue: string);
+begin
+ if AValue = '' then exit;
+ if UpperCase(AValue[1]) <> FIncap then begin
+ FInCap := UpperCase(AValue[1]);
+ Refresh;
+ end;
+end;
+
+procedure TJvJanToggle.SetOutCap(const AValue: string);
+begin
+ if AValue = '' then exit;
+ if UpperCase(AValue[1]) <> FOutcap then begin
+ FOutCap := UpperCase(AValue[1]);
+ Refresh;
+ end;
+end;
+
+procedure TJvJanToggle.SetButtonStyle(const AValue: TButtonStyle);
+begin
+ if AValue <> FButtonStyle then begin
+ FButtonstyle := AValue;
+ Refresh;
+ end;
+end;
+
+end.