{ Diverse Änderungen von Siro am 13.04.2020 } { Invalidate für die Persistenten Blöcke eingeführt } { sie haben alle einen fOwner bekommen, also einen Besitzer } { Tastensteuerung eingeführt } unit SliderComponent; {$mode objfpc}{$H+} interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,LCLIntf, LCLType, LMessages; const clMark = TColor($A1E7FA); type TKnob = (ksCircle,ksRectangle,ksRoundrect,ksArrowUp,ksArrowDown); type TMultiKnob = class(TPersistent) private FOwner : TCustomControl; // Siro, hier wird der Besitzer gespeichert FShowKnob2 : boolean; //2. Knopf sichtbar FShowKnob3 : boolean; //3. Knopf sichtbar FColorKnob2 : TColor; //2. Farbe FColorKnob3 : TColor; //3. Farbe FPosKnob2 : integer; //Position Knopf 2 FPosKnob3 : integer; //Position Knopf 3 protected procedure SetShowKnob2(const K2Show:boolean); procedure SetShowKnob3(const K3Show:boolean); procedure SetColorKnob2(const Farbe:TColor); procedure SetColorKnob3(const Farbe:TColor); procedure SetPosKnob2(const Wert:integer); procedure SetPosKnob3(const Wert:integer); public constructor create(aOwner:TCustomControl);// Siro neuer Constructor mit Parameter des Besitzers published property ShowKnob2 : boolean read FShowKnob2 write SetShowKnob2 default false; property ShowKnob3 : boolean read FShowKnob3 write SetShowKnob3 default false; property ColorKnob2 : TColor read FColorKnob2 write SetColorKnob2 default cllime; property ColorKnob3 : TColor read FColorKnob3 write SetColorKnob3 default clblue; property PosKnob2 : integer read FPosKnob2 write SetPosKnob2 default 5; property PosKnob3 : integer read FPosKnob3 write SetPosKnob3 default 10; end; type TChangeEvent = procedure(const Count: integer) of object; type TIndicator = class(TPersistent) private FOwner : TCustomControl; // Siro, hier wird der Besitzer gespeichert FIndicatorVisible : boolean; //Wert Anzeige sichtbar FIndicatorColor : TColor; //Hintergrund Wertanzeige FIndicatorFontColor : TColor; //Schriftfarbe protected procedure SetIndicatorVisible(const IndiVisible:boolean); procedure SetIndicatorColor(const Farbe:TColor); procedure SetIndicatorFontColor(const Farbe:TColor); public constructor create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers published property IndicatorVisible : boolean read FIndicatorVisible write SetIndicatorVisible default false; property IndicatorColor : TColor read FIndicatorColor write SetIndicatorColor default clMoneyGreen; property IndicatorFontColor : TColor read FIndicatorFontColor write SetIndicatorFontColor default clblack; end; type TMark = class(TPersistent) private FOwner : TCustomControl; // Siro, hier wird der Besitzer gespeichert FMarkVisible : boolean; //Marke bei 0 oder sonstwo FMark2Visible : boolean; FMarkColor : TColor; FMarkPosition : integer; FMark2Position : integer; procedure SetMarkVisible(const MarkVisible:boolean); procedure SetMarkColor(const Farbe:TColor); procedure SetMarkPosition(const Pos:integer); procedure SetMark2Visible(const Mark2Visible:boolean); procedure SetMark2Position(const Pos:integer); public constructor create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers published property MarkVisible : boolean read FMarkVisible write SetMarkVisible default false; property MarkColor : TColor read FMarkColor write SetMarkColor default clMark; property MarkPosition : integer read FMarkPosition write SetMarkPosition default 0; property Mark2Visible : boolean read FMark2Visible write SetMark2Visible default false; property Mark2Position : integer read FMark2Position write SetMark2Position; end; type TScale = class(TPersistent) private FOwner : TCustomControl; // Siro, hier wird der Besitzer gespeichert FLineColor : TColor; FMarkColor : TColor; FInterval : integer; FShowScale : boolean; procedure SetLineColor(const Farbe:TColor); procedure SetMarkColor(const Farbe:TColor); procedure SetInterval(const Wert:integer); procedure SetShowScale(const ShSc:boolean); public constructor create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers published property LineColor : TColor Read FLineColor Write SetLineColor default clblack; property MarkColor : TColor Read FMarkColor Write FMarkColor default clnavy; property Interval : integer Read FInterval Write FInterval default 2; property ShowScale : boolean Read FShowScale Write FShowScale default false; end; type TSliderComponent = class (TCustomControl) // frueher (TGraphicControl) Siro 13.04.2020 private { Private declarations } FKnob : TKnob; //SchieberKnopf FBackgroundColor : TColor; //Hintergrundfarbe FSlotColor : TColor; //Schlitzfarbe FSlotColorSel : TColor; //Schlitzfarbe selektiert FSlotColorSelVisible : boolean; // Selektiertefarbe ein FSlotColorExt : TColor; //Schlitzfarbe extra FSlotColorExtVisible : boolean; // Extrafarbe ein FExtMin : integer; //Min Wert FExtMax : integer; //Max Wert FKnobColor : TColor; //SchiebeKnopffarbe FBorderColor : TColor; //Randfarbe FBorderWidth : integer; //Randdicke FMin : integer; //kleinster Wert FMax : integer; //größter Wert FStep : integer; //Schritt bei Klick FPosition : integer; //Startwert und Position FIndicator : TIndicator; //Wertanzeige FMark : TMark; //Markierung FOnChange : TChangeEvent; //Geändert Ereigniss FScale : TScale; FMultiKnob : TMultiKnob; procedure SetKnob(const aValue : TKnob); procedure SetBackgroundColor(const Farbe:TColor); procedure SetSlotColor(const Farbe:TColor); procedure SetSlotColorSelVisible(const Sel:boolean); procedure SetSlotColorSel(const Farbe:TColor); procedure SetSlotColorExtVisible(const Ext:boolean); procedure SetSlotColorExt(const Farbe:TColor); procedure SetExtMin(const MinWert:integer); procedure SetExtMax(const MaxWert:integer); procedure SetKnobColor(const Farbe:TColor); procedure SetBorderColor(const Farbe:TColor); procedure SetBorderWidth(const Dicke:integer); procedure SetMin(const MinWert:integer); procedure SetMax(const MaxWert:integer); procedure SetStep(const Schritt:integer); procedure setPosition(const Position:integer); protected { Protected declarations,geschützte Deklarationen } FakY : double; MitteY : double; Knopf : TRect; MKnob : integer; Knopf2 : TRect; MKnob2 : integer; Knopf3 : TRect; MKnob3 : integer; links,rechts : integer; Skala : integer; Schritte : integer; schieben : boolean; schieben2 : boolean; schieben3 : boolean; PixelSchritt : double; zaehler : integer; versatz : integer; Mark1 : array [0..2] of TPoint; Mark2 : array [0..2] of TPoint; selektiert : boolean; extra : boolean; Pfeil : array [0..2] of TPoint; geaendert : Boolean; tmpcolor : TColor; procedure Loaded; override; procedure mousemove(Shift: TShiftState; X, Y: Integer);override; procedure MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);override; procedure MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; // Siro procedure CNKeyDown (var Message: TLMKeyDown); message CN_KEYDOWN; // Siro procedure DoExit; override; // wenn die Komponente den Focus verliert 13.04.2020 Siro procedure DoEnter; override; // wenn die Komponente den Focus erhält 13.04.2020 Siro public { Public declarations, öffentliche Deklarationen, nicht sichtbar im OI } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Paint; override; property Step : integer read FStep write SetStep default 1; published { Published declarations, veröffentlichte Deklarationen, sichtbar im OI } property Knob : TKnob read fKnob write SetKnob default kscircle; property Color_Background : TColor read FBackgroundColor write SetBackgroundColor default clMenuBar; property Color_Slot : TColor read FSlotColor write SetSlotColor default clWhite; property Color_Slot_Sel : TColor read FSlotColorSel write SetSlotColorSel default clGray; property ShowSelColor : boolean read FSlotColorSelVisible write SetSlotColorSelVisible default true; property Color_Slot_Ext : TColor read FSlotColorExt write SetSlotColorExt default clred; property ShowExtColor : boolean read FSlotColorExtVisible write SetSlotColorExtVisible default false; property ExtMin : integer read FExtMin write SetExtMin default 0; property ExtMax : integer read FExtMax write SetExtMax default 0; property Color_Knob : TColor read FKnobColor write SetKnobColor default clblack; property Border_Color : TColor read FBorderColor write SetBorderColor default clgray; property Border_Width : integer read FBorderWidth write SetBorderWidth default 1; property Min : integer read FMin write SetMin default 0; property Max : integer read FMax write SetMax default 10; property Position : integer read FPosition write setPosition default 0; property OnChange : TChangeEvent read FOnChange write FOnChange; property Scale : TScale read FScale write FScale; property Mark : TMark read FMark write FMark; property Indicator : TIndicator read FIndicator write FIndicator; property MultiKnob : TMultiKnob read FMultiKnob write FMultiKnob; property TabStop default TRUE; // 13.03.2020 Siro end; procedure Register; implementation constructor TSliderComponent.Create(AOwner: TComponent); begin inherited Create(AOwner); width := 200; height := 30; FKnob := kscircle; FBackgroundColor := clMenuBar; FSlotColor := clWhite; FSlotColorSel := clGray; FSlotColorSelVisible := true; FSlotColorExt := clred; FSlotColorExtVisible := false; FExtMin := 0; FExtMax := 0; FKnobColor := clblack; FBorderColor := clgray; FBorderWidth := 1; FMin := 0; FMax := 10; FStep := 1; FPosition := 0; FScale := TScale.Create(self); FScale.LineColor:=clblack; FScale.MarkColor:=clnavy; FScale.Interval:=2; FScale.ShowScale:=false; FMark := TMark.Create(self); // Siro, Besitzer übergeben ist die Komponenten selber FMark.FMarkVisible := false; FMark.FMarkColor := clMark; FMark.FMarkPosition := 0; FMark.FMark2Visible := false; FMark.Mark2Position := 0; FIndicator := TIndicator.Create(self); // Siro, Besitzer ist die Komponente selber FIndicator.FIndicatorVisible := false; FIndicator.FIndicatorColor := clMoneyGreen; FIndicator.FIndicatorFontColor := clblack; FMultiKnob := TMultiKnob.Create(self); // Siro, Besitzer ist die Komponente selber FMultiKnob.ShowKnob2 := false; FMultiKnob.ShowKnob3 := false; FMultiKnob.ColorKnob2 := cllime; FMultiKnob.ColorKnob3 := clblue; FMultiKnob.FPosKnob2 := 5; FMultiKnob.FPosKnob3 := 10; schieben := false; geaendert := false; TabStop:=TRUE; // 13.04.2020 Siro end; destructor TSliderComponent.Destroy; begin FScale.Free; FMark.Free; FIndicator.Free; FMultiKnob.Free; inherited Destroy; end; // Siro ---------- Die Tastensteuerung: procedure TSliderComponent.KeyDown(var Key: Word; Shift: TShiftState); var pix1:Double; p:TPoint; begin if Key = VK_LEFT then begin // Schieber nach links end; if Key = VK_RIGHT then begin // Schieber nach rechts end; if Key = VK_HOME then begin // Schieber links an Anfang end; if Key = VK_END then begin // Schieber rechts ans Ende end; inherited; end; // --- SIRO -------------------------------------------------------- // Damit der Fokus bei Cursortasten nicht an andere Komponenten weitergegeben wird, // werden die Tasten hier lediglich abgefangen und als bearbeitet markiert // indem das Message.result auf 1 gesetzt wird. // Alle Tasten welche die Komponente für sich beansprucht müssen in // die case Auswahl mit aufgeführt werden. procedure TSliderComponent.CNKeyDown(var Message: TLMKeyDown); begin with Message do begin Result := 1; { wir gehen davon aus daß die Message verarbeitet wird } case CharCode of VK_LEFT : if Position > min then Position:=Position-1; // Cursor Left VK_RIGHT : if Position < max then Position:=Position+1; // Cursor Right VK_HOME : Position:=0; // Cursor Home VK_END : Position:=Max; // Cursor End // VK_TAB : ; // hebelt TabStop aus.......Tab soll aber den Focus weiter reichen else begin Result := 0; { message wurde nicht verarbeitet } end; {else} end; { case } end; { with } inherited; // Vorgaenger immer aufrufen, jedoch mit dem entsprechendem Result end; constructor TScale.create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers begin FOwner:=aOwner; inherited create; // Siro end; procedure TScale.SetLineColor(const Farbe:TColor); begin if Farbe = FLineColor then exit; FLineColor:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TScale.SetMarkColor(const Farbe:TColor); begin if Farbe = FMarkColor then exit; FMarkColor:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TScale.SetInterval(const Wert:integer); begin if Wert = FInterval then exit; FInterval:=Wert; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TScale.SetShowScale(const ShSc:boolean); begin if ShSc = FShowScale then exit; FShowScale := ShSc; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TSliderComponent.SetKnob(const aValue : TKnob); begin if fKnob <> aValue then begin fKnob := aValue; Invalidate(); end; end; procedure TSliderComponent.SetBackgroundColor(const Farbe:TColor); begin if Farbe = FBackgroundColor then exit; FBackgroundColor:=Farbe; Invalidate; end; procedure TSliderComponent.SetSlotColor(const Farbe:TColor); begin if Farbe = FSlotColor then exit; FSlotColor:=Farbe; Invalidate; end; procedure TSliderComponent.SetSlotColorSelVisible(const Sel:boolean); begin if FSlotColorSelVisible = Sel then exit; FSlotColorSelVisible := Sel; Invalidate; end; procedure TSliderComponent.SetSlotColorSel(const Farbe:TColor); begin if Farbe = FSlotColorSel then exit; FSlotColorSel:=Farbe; Invalidate; end; procedure TSliderComponent.SetSlotColorExtVisible(const Ext:boolean); begin if FSlotColorExtVisible = Ext then exit; FSlotColorExtVisible := Ext; Invalidate; end; procedure TSliderComponent.SetSlotColorExt(const Farbe:TColor); begin if Farbe = FSlotColorExt then exit; FSlotColorExt:=Farbe; Invalidate; end; procedure TSliderComponent.SetExtMin(const MinWert:integer); begin if FExtMin = MinWert then exit; FExtMin:=MinWert; Invalidate; end; procedure TSliderComponent.SetExtMax(const MaxWert:integer); begin if FExtMax = MaxWert then exit; FExtMax:=MaxWert; Invalidate; end; procedure TSliderComponent.SetKnobColor(const Farbe:TColor); begin if Farbe = FKnobColor then exit; FKnobColor:=Farbe; Invalidate; end; procedure TSliderComponent.SetBorderColor(const Farbe:TColor); begin if Farbe = FBorderColor then exit; FBorderColor:=Farbe; Invalidate; end; procedure TSliderComponent.SetBorderWidth(const Dicke:integer); begin if Dicke = FBorderWidth then exit; FBorderWidth:=Dicke; Invalidate; end; procedure TSliderComponent.SetMin(const MinWert:integer); begin if MinWert = FMin then exit; FMin:=MinWert; Invalidate; end; procedure TSliderComponent.SetMax(const MaxWert:integer); begin if MaxWert = FMax then exit; FMax:=MaxWert; Invalidate; end; procedure TSliderComponent.SetStep(const Schritt:integer); begin if Schritt = FStep then exit; FStep:=Schritt; Invalidate; end; procedure TSliderComponent.setPosition(const Position:integer); begin if Position = FPosition then exit; FPosition:=Position; if FPosition < FMin then FPosition := FMin; if FPosition > FMax then FPosition := FMax; if Assigned(OnChange) then OnChange(Position); Invalidate; end; constructor TIndicator.create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers begin FOwner:=aOwner; inherited create; // Siro end; procedure TIndicator.SetIndicatorVisible(const IndiVisible:boolean); begin if FIndicatorVisible =IndiVisible then exit; FIndicatorVisible :=IndiVisible; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TIndicator.SetIndicatorColor(const Farbe:TColor); begin if FIndicatorColor=Farbe then exit; FIndicatorColor:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TIndicator.SetIndicatorFontColor(const Farbe:TColor); begin if FIndicatorFontColor=Farbe then exit; FIndicatorFontColor:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; constructor TMark.create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers begin FOwner:=aOwner; inherited create; // Siro end; procedure TMark.SetMarkVisible(const MarkVisible:boolean); begin if FMarkVisible =MarkVisible then exit; FMarkVisible :=MarkVisible; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMark.SetMarkColor(const Farbe:TColor); begin if FMarkColor=Farbe then exit; FMarkColor:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMark.SetMarkPosition(const Pos:integer); begin if FMarkPosition = Pos then exit; FMarkPosition := Pos; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMark.SetMark2Visible(const Mark2Visible:boolean); begin if FMark2Visible = Mark2Visible then exit; FMark2Visible :=Mark2Visible; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMark.SetMark2Position(const Pos:integer); begin if FMark2Position = Pos then exit; FMark2Position := Pos; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; constructor TMultiKnob.create(aOwner:TCustomControl); // Siro neuer Constructor mit Parameter des Besitzers begin FOwner:=aOwner; inherited create; end; procedure TMultiKnob.SetShowKnob2(const K2Show:boolean); begin if fShowKnob2 = K2Show then exit; fShowKnob2 :=K2Show; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMultiKnob.SetShowKnob3(const K3Show:boolean); begin if fShowKnob3 = K3Show then exit; fShowKnob3 :=K3Show; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMultiKnob.SetColorKnob2(const Farbe:TColor); begin if fColorKnob2=Farbe then exit; fColorKnob2:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMultiKnob.SetColorKnob3(const Farbe:TColor); begin if fColorKnob3=Farbe then exit; fColorKnob3:=Farbe; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMultiKnob.SetPosKnob2(const Wert:integer); begin if FPosKnob2 = Wert then exit; FPosKnob2 := Wert; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; procedure TMultiKnob.SetPosKnob3(const Wert:integer); begin if FPosKnob3 = Wert then exit; FPosKnob3 := Wert; if Assigned(FOwner) then FOwner.Invalidate; // wenn Besitzer existiert, sien Invalidate aufrufen end; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX----ENDE DER SET PROZEDUREN----XXXXXXXXXXXX} procedure TSliderComponent.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); var P1 : TPoint; begin SetFocus; // Siro P1.X:=x; P1.Y:=y; if ptinrect(Knopf,P1) then schieben:=true; if (ptinrect(Knopf2,P1)) and (schieben=false) then schieben2:=true; if (ptinrect(Knopf3,P1)) and (schieben=false) and (schieben2=false) then schieben3:=true; if (schieben=false) and (schieben2=false) and (schieben3=false) then begin if ptinrect(rect(0,0,Knopf.Left,height),P1) then begin Position:= Position - FStep; Invalidate; end; if ptinrect(rect(Knopf.Right,0,width,height),P1) then begin Position:= Position + FStep; Invalidate; end; end; end; procedure TSliderComponent.mousemove(Shift: TShiftState; X, Y: Integer); var lv:integer; begin // SetFocus; // je nach Bedarf kann hier auch der Focus aktiviert werden Siro if schieben then begin for lv:= FMin to FMax do begin if (x>=links+round(Pixelschritt*(lv-versatz))) and (x width-round(FakY*8) then Position:=FMax; if x < round(FakY*8) then Position:=FMin; end; //if Assigned(OnChange) then OnChange(Position); Invalidate; end; if schieben2 then begin for lv:= FMin to FMax do begin if (x>=links+round(Pixelschritt*(lv-versatz))) and (x width-round(FakY*8) then FMultiKnob.FPosKnob2:=FMax; if x < round(FakY*8) then FMultiKnob.FPosKnob2:=FMin; end; if Assigned(OnChange) then OnChange(Position); Invalidate; end; if schieben3 then begin for lv:= FMin to FMax do begin if (x>=links+round(Pixelschritt*(lv-versatz))) and (x width-round(FakY*8) then FMultiKnob.FPosKnob3:=FMax; if x < round(FakY*8) then FMultiKnob.FPosKnob3:=FMin; end; if Assigned(OnChange) then OnChange(Position); Invalidate; end; end; procedure TSliderComponent.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer); begin if schieben then schieben :=false; if schieben2 then schieben2 :=false; if schieben3 then schieben3 :=false; end; procedure TSliderComponent.DoEnter; // erhält den Focus 13.04.2020 Siro begin invalidate; // Neu zeichnen mit Focus inherited; end; procedure TSliderComponent.DoExit; // verliert den Focus 13.04.2020 Siro begin invalidate; // Neu zeichnen, jetzt ohne Focus inherited; end; procedure TSliderComponent.Loaded; var temp : integer; begin inherited; if FMin > FMax then begin temp:=FMin; FMin:=FMax; FMax:=temp; end; if PositionFMax then Position := FMax; end; {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX----AB HIER PAINT----XXXXXXXXXXXXXXXXXXXXXXXXX} procedure TSliderComponent.Paint; var lv,ExtL,ExtR,temp : integer; ScMark : TRect; begin FakY := height / 30; MitteY := height / 2; links := round((FakY*8)+(6*FakY)); //linkes Ende der Skala rechts := width-round(((FakY*8)+(6*FakY))); //rechtes Ende der Skala Skala := rechts-links; //Länge Skala {Positiverbereich 0 bis ..} if FMin >=0 then begin Schritte:= (FMax-FMin); end; {Negativerbereich } if FMax <=0 then begin Schritte:= (FMax-FMin); end; {Um 0 } if (FMin <0) and (FMax>0) then begin Schritte:= (0-FMin)+FMax; end; Pixelschritt:= Skala/Schritte; versatz:=0+FMin; //Mitte des Knopfes bestimmen for lv:= FMin to FMax do begin if lv= FPosition then MKnob:= links+round(Pixelschritt*(lv-versatz)); end; for lv:= FMin to FMax do begin if lv= FMultiKnob.FPosKnob2 then MKnob2:= links+round(Pixelschritt*(lv-versatz)); end; for lv:= FMin to FMax do begin if lv= FMultiKnob.FPosKnob3 then MKnob3:= links+round(Pixelschritt*(lv-versatz)); end; Knopf := rect(round(MKnob-(6*FakY)),round(MitteY-(6*FakY)),round(MKnob+(6*FakY)),round(MitteY+(6*FakY))); Knopf:= rect(Knopf.Left-1,Knopf.Top-1,Knopf.Right+1,Knopf.Bottom+1); Knopf2 := rect(round(MKnob2-(6*FakY)),round(MitteY-(6*FakY)),round(MKnob2+(6*FakY)),round(MitteY+(6*FakY))); Knopf2:= rect(Knopf2.Left-1,Knopf2.Top-1,Knopf2.Right+1,Knopf2.Bottom+1); Knopf3 := rect(round(MKnob3-(6*FakY)),round(MitteY-(6*FakY)),round(MKnob3+(6*FakY)),round(MitteY+(6*FakY))); Knopf3:= rect(Knopf3.Left-1,Knopf3.Top-1,Knopf3.Right+1,Knopf3.Bottom+1); //Position der Markierung for lv:= FMin to FMax do begin if lv= FMark.FMarkPosition then begin Mark1[0]:=Point(links+round(Pixelschritt*(lv-versatz)),Knopf.Bottom); Mark1[1]:=Point(Mark1[0].X+round(5*FakY),Knopf.Bottom+round(5*FakY)); Mark1[2]:=Point(Mark1[0].X-round(5*FakY),Knopf.Bottom+round(5*FakY)); end; end; for lv:= FMin to FMax do //Position der 2.Markierung begin if lv= FMark.FMark2Position then begin Mark2[0]:=Point(links+round(Pixelschritt*(lv-versatz)),Knopf.Bottom); Mark2[1]:=Point(Mark2[0].X+round(5*FakY),Knopf.Bottom+round(5*FakY)); Mark2[2]:=Point(Mark2[0].X-round(5*FakY),Knopf.Bottom+round(5*FakY)); end; end; //Hintergrund temp := canvas.Pen.Width; canvas.Pen.Width := FBorderWidth; canvas.Pen.Color := FBorderColor; // normal color if Focused then // 13.04.2020 Siro testweise mal die Farbe geaendert canvas.Brush.Color:= clRed // FocusedColor else canvas.Brush.Color:=FBackgroundColor; // normal Color canvas.Rectangle(0,0,width,height); canvas.Pen.Width := temp; //Schiebenut canvas.Pen.Color := FSlotColor; canvas.Brush.Color:= FSlotColor; canvas.Rectangle(round(FakY*8),round(MitteY-(3*FakY)),width-round(FakY*8),round(MitteY+(3*FakY))); if FSlotColorSelVisible then begin canvas.Pen.Color := FSlotColorSel; canvas.Brush.Color:= FSlotColorSel; if (FMax<=0) then canvas.Rectangle(MKnob,round(MitteY-(3*FakY)),width-round(FakY*8),round(MitteY+(3*FakY))) else canvas.Rectangle(round(FakY*8),round(MitteY-(3*FakY)),MKnob,round(MitteY+(3*FakY))); end; if FSlotColorExtVisible then begin canvas.Pen.Color := FSlotColorExt; canvas.Brush.Color:= FSlotColorExt; for lv:= FMin to FMax do begin if lv= ExtMin then ExtL:= links+round(Pixelschritt*(lv-versatz)); if lv= ExtMax then ExtR:= links+round(Pixelschritt*(lv-versatz)); end; canvas.Rectangle(ExtL,round(MitteY-(3*FakY)),ExtR,round(MitteY+(3*FakY))); if FExtMin = fmin then canvas.Rectangle(round(FakY*8),round(MitteY-(3*FakY)),ExtR,round(MitteY+(3*FakY))); if FExtMax = fmax then canvas.Rectangle(ExtL,round(MitteY-(3*FakY)),width-round(FakY*8),round(MitteY+(3*FakY))); end; //SchiebeKnopf3 if FMultiKnob.FShowKnob3 then begin canvas.Pen.Color := FMultiKnob.ColorKnob3; canvas.Brush.Color:= FMultiKnob.ColorKnob3; if FKnob = ksrectangle then canvas.Rectangle(Knopf3); if FKnob = kscircle then canvas.Ellipse(Knopf3); if FKnob = ksroundrect then canvas.RoundRect(Knopf3,round(4*FakY),round(4*FakY)); if FKnob = ksArrowUp then begin canvas.Rectangle(Rect(Knopf3.Left,Knopf3.Top,Knopf3.Right,Knopf3.Bottom)); Pfeil[0].Y := Knopf3.Top; Pfeil[0].X := Knopf3.Left; Pfeil[1].X := MKnob3; Pfeil[1].Y := Knopf3.Top-(round(Knopf3.Width/4)); Pfeil[2].X := Knopf3.Right-1; Pfeil[2].Y := Knopf3.Top; canvas.Polygon(Pfeil); end; if FKnob = ksArrowDown then begin canvas.Rectangle(Rect(Knopf3.Left,Knopf3.Top,Knopf3.Right,Knopf3.Bottom)); Pfeil[0].Y := Knopf3.Bottom; Pfeil[0].X := Knopf3.Left; Pfeil[1].X := MKnob3; Pfeil[1].Y := Knopf3.Bottom+(round(Knopf3.Width/4)); Pfeil[2].X := Knopf3.Right-1; Pfeil[2].Y := Knopf3.Bottom; canvas.Polygon(Pfeil); end; end; //SchiebeKnopf2 if FMultiKnob.FShowKnob2 then begin canvas.Pen.Color := FMultiKnob.ColorKnob2; canvas.Brush.Color:= FMultiKnob.ColorKnob2; if FKnob = ksrectangle then canvas.Rectangle(Knopf2); if FKnob = kscircle then canvas.Ellipse(Knopf2); if FKnob = ksroundrect then canvas.RoundRect(Knopf2,round(4*FakY),round(4*FakY)); if FKnob = ksArrowUp then begin canvas.Rectangle(Rect(Knopf2.Left,Knopf2.Top,Knopf2.Right,Knopf2.Bottom)); Pfeil[0].Y := Knopf2.Top; Pfeil[0].X := Knopf2.Left; Pfeil[1].X := MKnob2; Pfeil[1].Y := Knopf2.Top-(round(Knopf2.Width/4)); Pfeil[2].X := Knopf2.Right-1; Pfeil[2].Y := Knopf2.Top; canvas.Polygon(Pfeil); end; if FKnob = ksArrowDown then begin canvas.Rectangle(Rect(Knopf2.Left,Knopf2.Top,Knopf2.Right,Knopf2.Bottom)); Pfeil[0].Y := Knopf2.Bottom; Pfeil[0].X := Knopf2.Left; Pfeil[1].X := MKnob2; Pfeil[1].Y := Knopf2.Bottom+(round(Knopf2.Width/4)); Pfeil[2].X := Knopf2.Right-1; Pfeil[2].Y := Knopf2.Bottom; canvas.Polygon(Pfeil); end; end; //Schiebeknopf canvas.Pen.Color := FKnobColor; canvas.Brush.Color:= FKnobColor; if FKnob = ksrectangle then canvas.Rectangle(Knopf); if FKnob = kscircle then canvas.Ellipse(Knopf); if FKnob = ksroundrect then begin canvas.RoundRect(Knopf,round(4*FakY),round(4*FakY)); end; if FKnob = ksArrowUp then begin canvas.Rectangle(Rect(Knopf.Left,Knopf.Top,Knopf.Right,Knopf.Bottom)); Pfeil[0].Y := Knopf.Top; Pfeil[0].X := Knopf.Left; Pfeil[1].X := MKnob; Pfeil[1].Y := Knopf.Top-(round(Knopf.Width/4)); Pfeil[2].X := Knopf.Right-1; Pfeil[2].Y := Knopf.Top; canvas.Polygon(Pfeil); end; if FKnob = ksArrowDown then begin canvas.Rectangle(Rect(Knopf.Left,Knopf.Top,Knopf.Right,Knopf.Bottom)); Pfeil[0].Y := Knopf.Bottom; Pfeil[0].X := Knopf.Left; Pfeil[1].X := MKnob; Pfeil[1].Y := Knopf.Bottom+(round(Knopf.Width/4)); Pfeil[2].X := Knopf.Right-1; Pfeil[2].Y := Knopf.Bottom; canvas.Polygon(Pfeil); end; if FMark.FMarkVisible then //Markierung begin canvas.Pen.Color := FMark.FMarkColor; canvas.Brush.Color:= FMark.FMarkColor; canvas.Line(MKnob,round(MitteY),MKnob,Knopf.Bottom); //Markierung im SchiebeKnopf canvas.Polygon(Mark1); end; if FMark.FMark2Visible then //2.Markierung begin canvas.Pen.Color := FMark.FMarkColor; canvas.Brush.Color:= FMark.FMarkColor; canvas.Polygon(Mark2); end; //Wertanzeige if FIndicator.FIndicatorVisible then begin canvas.Brush.Color := FIndicator.FIndicatorColor; canvas.Pen.Color := FIndicator.FIndicatorColor; canvas.Font.Height := round(10*FakY); if canvas.Font.Height < 10 then canvas.Font.Height:= 10; canvas.Font.Color := FIndicator.FIndicatorFontColor; if fPosition <= round(fmax/2) then begin canvas.TextOut(Knopf.Right,round(MitteY)-round(canvas.TextHeight(inttostr(fPosition))/2),inttostr(fPosition)); end; if fPosition > round(fmax/2) then begin canvas.TextOut(Knopf.Left-canvas.TextWidth(inttostr(fPosition)),round(MitteY)-round(canvas.TextHeight(inttostr(fPosition))/2),inttostr(fPosition)); end; end; if FSlotColorSelVisible then //bei Kugel als Knopf bei max letzte Pixel abdecken begin if (FPosition = fmax) and (geaendert=false) and (FMax>0) then begin tmpcolor:=fslotcolor; FSlotColor:=FSlotColorSel; geaendert :=true; end; if (FPosition<> fmax) and geaendert then begin FSlotColor:= tmpcolor; end; end; if FScale.FShowScale then //Skala begin canvas.Pen.Color :=FScale.FLineColor; canvas.Line(links,Knopf.Bottom+round(3*FakY),rechts,Knopf.Bottom+round(3*FakY)); canvas.Pen.Color :=FScale.FMarkColor; canvas.Brush.Color :=FScale.FMarkColor; ScMark := rect(links-round(2*FakY),(Knopf.Bottom+round(3*FakY))-round(2*FakY),links+round(2*FakY),(Knopf.Bottom+round(3*FakY))+round(2*FakY)); for lv:= 0 to round((FMax-FMin)/FScale.FInterval)-1 do Canvas.Ellipse(SCMark.Left+round(Pixelschritt*lv*FScale.FInterval),SCMark.Top,SCMark.Right+round(Pixelschritt*lv*FScale.FInterval),SCMark.Bottom); Canvas.Ellipse((SCMark.Left+rechts)-links,SCMark.Top,(SCMark.Right+rechts)-links,SCMark.Bottom); end; end; procedure Register; begin {$I slidercomponent_icon.lrs} RegisterComponents('Fremde',[TSliderComponent]); end; end.