From 5009f8afeb0192fd48f6f38a51995542cc0d9b2f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 1 Apr 2018 19:43:02 +0000 Subject: [PATCH] jvcllaz: Add TJvJanLED and TJvJanToggle git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6287 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvJans/images/images.txt | 2 + .../design/JvJans/images/tjvjanled.bmp | Bin 0 -> 406 bytes .../design/JvJans/images/tjvjantoggle.bmp | Bin 0 -> 406 bytes .../design/JvJans/images/tjvmarkuplabel.bmp | Bin 0 -> 1654 bytes .../design/JvJans/images/tjvmarkupviewer.bmp | Bin 0 -> 1654 bytes .../jvcllaz/design/JvJans/jvjansreg.pas | 7 +- components/jvcllaz/packages/jvjanslazr.lpk | 10 +- components/jvcllaz/resource/jvjansreg.res | Bin 22076 -> 22964 bytes components/jvcllaz/run/JvJans/jvjanled.pas | 124 ++++++ components/jvcllaz/run/JvJans/jvjantoggle.pas | 397 ++++++++++++++++++ 10 files changed, 537 insertions(+), 3 deletions(-) create mode 100644 components/jvcllaz/design/JvJans/images/tjvjanled.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvjantoggle.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvmarkuplabel.bmp create mode 100644 components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp create mode 100644 components/jvcllaz/run/JvJans/jvjanled.pas create mode 100644 components/jvcllaz/run/JvJans/jvjantoggle.pas 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 0000000000000000000000000000000000000000..9b8aef208d84afc1f5c5269fd8fdc629fe7f274f GIT binary patch literal 406 zcmZvWu?@m75JfK%3z#(2u1Fh$lo|mY6>I=bU~dbuCXq2soJ|#Tb!2aPp05oqZnJd>lXIr9Rll!YBM1aT9))jrcTWNA`=g4@aJ`sT|jw2uuIPh|3&1?rz!Tf>DbX^r3Qt*vScNPx{x- VRsT;{)qKD%|9$AS0kyoxd;w9A zQIEWL(w*-6kDs4pwQnCqzH;|vcO{=!-af1_mn*_%wGiQyhzVS|m8z2ZS916Fw}=`X z6f{w25fdo5F-IU#Xb~4E4E*pwqR{(um1uAT5``AwR#IVb1QLbjB?StDBakSx2&c5d z;0PoNEhfCCD7M29NECXerb;w80*OM;v`vWyM<7w?SrS*G!4XIldX_7cXmA7)g`TBM zB^n%oM4@MyONj3)rya7~uKdFTrOW(@{$x3C-xOZ* zZwhPtt^e(1;gG*59P`J*^LsMR#ZXUsoBZ(~YZ^Cu{#{|^?`fy|)9LZ_Jk!Z+5POZWrf4g^m$ukB+an2C0`8E9e{Ce){zh3vX|0-<#w`HHf)~jp}*lLed gCViUxe%)4mpZWE%u<}#5J{Bgw3fC8f{m-n%e^PERq5uE@ literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp b/components/jvcllaz/design/JvJans/images/tjvmarkupviewer.bmp new file mode 100644 index 0000000000000000000000000000000000000000..2c6fc5e270a72c24c10067281410f5fe5845c3cc GIT binary patch literal 1654 zcmZY7F>)I*3_wvhlZkSKlqhq8xUz&vpF7|bsc{q(nVbV%W^#rUID%V`HQs!Za=cQw z`veN)a!D?~e*6AGX8H17*tOz%n~Bp60rimRHdq<{**la{wbmc z2MwAiw1^25RLl`b6k5au3Il&UkSO%!y-GAV0*OM4P?b~|9DziknWR8ra0C*C7U7mw z7#x8_p~Zx0ieg-jK%&rVX{tnnBakTcTDB?C;0PoNy|%=aXmA7)gj&UUlEujL1!4XIldVMxiqQMbJ z6ncG9SE9iYNECW~Ze9{$a0C*CUPmF7XmA7)g=cq^OkKJHE@j-KfjK<^6>ERa$aSZr8@J^&oo`xNzas$rksH@wc1aju4Xxs;XPKd~Lgb;<70AG& z(MStfR>=lZW@ literal 0 HcmV?d00001 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 a8be459a3f576e764b75131ac2da97db2309a8ab..51112dcd55739954898d7fcd3c99e0f45dfa0a3c 100644 GIT binary patch delta 855 zcmbV}Jxjw-6oyYk+#GH*cJihmbrP>)H>src1F@hHLe}EcxHvZsLY8MjbMLty@ATDp9~*C9r{%yP+9jeiT_cCisg1u*mvljm z!I9;!qqIWFoM_H}LcLy3PfC&mBXf#|DQYhmIpS1G3C)?bJ|(L zvuRxNmlX~~#xc0G2qI=KC?yw+LJ)vs~!zYNVDU44NPYi%C;3yvrtN(m-AZ48yVxglrb(sg#xUR zRKsKa^v0nUo#2B2nYSIuPI+*L@5}(MXsD7QZn&v&au2X71xU+Yg#~2ghPw$~r8t5~9L0T;IL2@*w9n jDp~%YY%Dk6J|rso_VzK@$Pc9MH|XiPRUVhlb~e8Oz0BCs delta 22 ecmdn8nQ_k=#tmOQCLge7nJf}4wYkejix&WRY6&C& 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.