xitrackbar.pas

Xi control is a component for delphi. its have alot of feature like customizable button, gradient s

      FAbsPos:= Y - 5;
      if FAbsPos < 0 then FAbsPos:= 0;
      if FAbsPos > FAbsLength then FAbsPos:= FAbsLength;
    end;

    FPosition:= Round(FAbsPos * (FMax - FMin) / FAbsLength) + FMin;
    FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin));
   if Assigned(FOnChange) then FOnChange(self);
  end;

  Paint;
end;

procedure TXiTrackBar.Resize;
begin
  Paint;
end;

procedure TXiTrackBar.CMEnabledChanged(var msg: TMessage);
begin
  inherited;
  Paint;
end;

procedure TXiTrackBar.SetColors(Index: Integer; Value: TColor);
begin
  case Index of
    0:  FBackColor:= Value;
    1:  FTickColor:= Value;
    2:  FDisabledTickColor:= Value;
    10: FSlideBorderColor:= Value;
    11: FSlideFaceColor:= Value;
    12: FSlideGradColor:= Value;
    13: FDisabledSlideBorderColor:= Value;
    14: FDisabledSlideFaceColor:= Value;
    15: FDisabledSlideGradColor:= Value;
    16: FDisabledThumbBorderColor:= Value;
    17: FDisabledThumbFaceColor:= Value;
    18: FDisabledThumbGradColor:= Value;
    20: FThumbBorderColor:= Value;
    21: FThumbFaceColor:= Value;
    22: FThumbGradColor:= Value;
    30: FOverThumbBorderColor:= Value;
    31: FOverThumbFaceColor:= Value;
    32: FOverThumbGradColor:= Value;
    40: FDownThumbBorderColor:= Value;
    41: FDownThumbFaceColor:= Value;
    42: FDownThumbGradColor:= Value;
  end;
  FColorScheme:= csCustom;
  Paint;
end;

procedure TXiTrackBar.SetPosition(Value: Integer);
begin
  if (Value < FMin) then Value:= FMin;
  if (Value > FMax) then Value:= FMax;
  FPosition:= Value;
  FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin));
  Paint;
  if Assigned(FOnChange) then FOnChange(self);
end;

procedure TXiTrackBar.SetMin(Value: Integer);
begin
  FMin:= Value;
  if FPosition < FMin then FPosition:= FMin;
  FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin));
  Paint;
end;

procedure TXiTrackBar.SetMax(Value: Integer);
begin
  FMax:= Value;
  if FPosition > FMax then FPosition:= FMax;
  FAbsPos:= Round((FAbsLength / (FMax - FMin)) * (FPosition - FMin));
  Paint;
end;

procedure TXiTrackBar.SetFrequency(Value: Integer);
begin
  FFrequency:= Value;
  Paint;
end;

procedure TXiTrackBar.SetThumbLength(Value: Integer);
begin
  FThumbLength:= Value;
  Paint;
end;

procedure TXiTrackBar.SetThumbWidth(Value: Integer);
begin
  FThumbWidth:= Value;
  Paint;
end;


procedure TXiTrackBar.SetTickStyle(Value: TTickStyle);
begin
  FTickStyle:= Value;
  Paint;
end;

procedure TXiTrackBar.SetTickMarks(Value: TTickMark);
begin
  FTickMarks:= Value;
  Paint;
end;

procedure TXiTrackBar.SetOrientation(Value: TTrackBarOrientation);
begin
  FOrientation:= Value;
  Paint;
end;

procedure TXiTrackBar.SetSmoothCorners(Value: Boolean);
begin
  FSmoothCorners:= Value;
  Paint;
end;

procedure TXiTrackBar.SetColorScheme(Value: TColorScheme);
begin
  FColorScheme:= Value;
  case FColorScheme of
    csDesert: begin
                FBackColor:=clBtnFace;
                FTickColor:=$00006A9D;
                FSlideBorderColor:=$000082BF;
                FSlideFaceColor:=$0028B9FF;
                FSlideGradColor:=$00BBE9FF;
                FThumbBorderColor:=$00005B88;
                FThumbFaceColor:=$008CDAFF;
                FThumbGradColor:=$000093D9;
                FOverThumbBorderColor:=$00005680;
                FOverThumbFaceColor:=$005ECBFF;
                FOverThumbGradColor:=$00007BB7;
                FDownThumbBorderColor:=$00005680;
                FDownThumbFaceColor:=$000083C1;
                FDownThumbGradColor:=$001AB5FF;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
    csGrass:  begin
                FBackColor:=clBtnFace;
                FTickColor:=$001D9A4B;
                FSlideBorderColor:=$0020A452;
                FSlideFaceColor:=$003ED978;
                FSlideGradColor:=$00C1F4D6;
                FThumbBorderColor:=$00126732;
                FThumbFaceColor:=$0082E8AA;
                FThumbGradColor:=$0021AB55;
                FOverThumbBorderColor:=$00156F37;
                FOverThumbFaceColor:=$007CE7A7;
                FOverThumbGradColor:=$001E954A;
                FDownThumbBorderColor:=$00156F37;
                FDownThumbFaceColor:=$0020A251;
                FDownThumbGradColor:=$005EE193;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
    csSky:    begin
                FBackColor:=clBtnFace;
                FTickColor:=$00C88D2D;
                FSlideBorderColor:=$00F47A00;
                FSlideFaceColor:=$00FFBA75;
                FSlideGradColor:=$00FFE9D2;
                FThumbBorderColor:=$00C66300;
                FThumbFaceColor:=$00FFD9B3;
                FThumbGradColor:=$00FF9224;
                FOverThumbBorderColor:=$00B35900;
                FOverThumbFaceColor:=$00FFCF9F;
                FOverThumbGradColor:=$00F97C00;
                FDownThumbBorderColor:=$00B35900;
                FDownThumbFaceColor:=$00FF8C1A;
                FDownThumbGradColor:=$00FFBF80;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
    csSun:    begin
                FBackColor:=clBtnFace;
                FTickColor:=$0000A4A4;
                FSlideBorderColor:=$000077AA;
                FSlideFaceColor:=$001AD9FB;
                FSlideGradColor:=$00DAFAFE;
                FThumbBorderColor:=$00004F84;
                FThumbFaceColor:=$00C6FFFF;
                FThumbGradColor:=$0000B8E6;
                FOverThumbBorderColor:=$00004F84;
                FOverThumbFaceColor:=$006AFFFF;
                FOverThumbGradColor:=$00009CC4;
                FDownThumbBorderColor:=$00004F84;
                FDownThumbFaceColor:=$0000B8E6;
                FDownThumbGradColor:=$0091E9FF;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
    csRose:   begin
                FBackColor:=clBtnFace;
                FTickColor:=$005B5BFF;
                FSlideBorderColor:=$004242FF;
                FSlideFaceColor:=$008282FF;
                FSlideGradColor:=$00C6DBFF;
                FThumbBorderColor:=$000000D7;
                FThumbFaceColor:=$009DC2FF;
                FThumbGradColor:=$006666FF;
                FOverThumbBorderColor:=$000000D7;
                FOverThumbFaceColor:=$008CB8FF;
                FOverThumbGradColor:=$005151FF;
                FDownThumbBorderColor:=$000000D7;
                FDownThumbFaceColor:=$006666FF;
                FDownThumbGradColor:=$008CB8FF;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
    csSilver: begin
                FBackColor:=clBtnFace;
                FTickColor:=$00888888;
                FSlideBorderColor:=$00727272;
                FSlideFaceColor:=clSilver;
                FSlideGradColor:=$00EAEAEA;
                FThumbBorderColor:=$00616161;
                FThumbFaceColor:=$00E1E1E1;
                FThumbGradColor:=$00A3A3A3;
                FOverThumbBorderColor:=$00747474;
                FOverThumbFaceColor:=$00D1D1D1;
                FOverThumbGradColor:=$00959595;
                FDownThumbBorderColor:=$00747474;
                FDownThumbFaceColor:=$00999999;
                FDownThumbGradColor:=$00C1C1C1;
                FDisabledTickColor:=clSilver;
                FDisabledSlideBorderColor:=$00BEBEBE;
                FDisabledSlideFaceColor:=$00D8D8D8;
                FDisabledSlideGradColor:=$00E8E8E8;
                FDisabledThumbBorderColor:=$00B5B5B5;
                FDisabledThumbFaceColor:=$00EAEAEA;
                FDisabledThumbGradColor:=$00CFCFCF;
              end;
  end;
  Invalidate;
end;

function TXiTrackBar.GetColorScheme: TStringList;
const
  t = '                ';
begin
  Result:= TStringList.Create;
  with Result do begin
    Add(t+'FBackColor:='+ColorToString(FBackColor)+';');
    Add(t+'FTickColor:='+ColorToString(FTickColor)+';');
    Add(t+'FSlideBorderColor:='+ColorToString(FSlideBorderColor)+';');
    Add(t+'FSlideFaceColor:='+ColorToString(FSlideFaceColor)+';');
    Add(t+'FSlideGradColor:='+ColorToString(FSlideGradColor)+';');
    Add(t+'FThumbBorderColor:='+ColorToString(FThumbBorderColor)+';');
    Add(t+'FThumbFaceColor:='+ColorToString(FThumbFaceColor)+';');
    Add(t+'FThumbGradColor:='+ColorToString(FThumbGradColor)+';');
    Add(t+'FOverThumbBorderColor:='+ColorToString(FOverThumbBorderColor)+';');
    Add(t+'FOverThumbFaceColor:='+ColorToString(FOverThumbFaceColor)+';');
    Add(t+'FOverThumbGradColor:='+ColorToString(FOverThumbGradColor)+';');
    Add(t+'FDownThumbBorderColor:='+ColorToString(FDownThumbBorderColor)+';');
    Add(t+'FDownThumbFaceColor:='+ColorToString(FDownThumbFaceColor)+';');
    Add(t+'FDownThumbGradColor:='+ColorToString(FDownThumbGradColor)+';');

    Add(t+'FDisabledTickColor:='+ColorToString(FDisabledTickColor)+';');
    Add(t+'FDisabledSlideBorderColor:='+ColorToString(FDisabledSlideBorderColor)+';');
    Add(t+'FDisabledSlideFaceColor:='+ColorToString(FDisabledSlideFaceColor)+';');
    Add(t+'FDisabledSlideGradColor:='+ColorToString(FDisabledSlideGradColor)+';');
    Add(t+'FDisabledThumbBorderColor:='+ColorToString(FDisabledThumbBorderColor)+';');
    Add(t+'FDisabledThumbFaceColor:='+ColorToString(FDisabledThumbFaceColor)+';');
    Add(t+'FDisabledThumbGradColor:='+ColorToString(FDisabledThumbGradColor)+';');
  end;
end;

procedure TXiTrackBar.GradientFillRect(Canvas: TCanvas; Rect: TRect;
                StartColor, EndColor: TColor; Direction: TFillDirection);
var
  Steps: Integer;
  StartR, StartG, StartB, EndR, EndG, EndB: Byte;
  CrrR, CrrG, CrrB: Double;
  IncR, IncG, incB: Double;
  i: integer;
begin
  case Direction of
    fdVertical:   Steps:= Rect.Bottom - Rect.Top;
    fdHorizontal: Steps:= Rect.Right - Rect.Left;
    fdDiagonal:   Steps:= Rect.Bottom - Rect.Top + Rect.Right - Rect.Left;
  end;

  StartR:= GetRValue(StartColor);  EndR:= GetRValue(EndColor);
  StartG:= GetGValue(StartColor);  EndG:= GetGValue(EndColor);
  StartB:= GetBValue(StartColor);  EndB:= GetBValue(EndColor);
                 
  IncR:= (EndR - StartR) / steps;
  IncG:= (EndG - StartG) / steps;
  IncB:= (EndB - StartB) / steps;

  CrrR:= StartR;
  CrrG:= StartG;
  CrrB:= StartB;

  for i:= 0 to Steps-1 do begin
    Canvas.Pen.Color:= RGB(Round(CrrR), Round(CrrG), Round(CrrB));
    case Direction of
      fdVertical:   begin
                      Canvas.MoveTo(Rect.Left, Rect.Top + i);
                      Canvas.LineTo(Rect.Right, Rect.Top + i);
                    end;
      fdHorizontal: begin
                      Canvas.MoveTo(Rect.Left+i, Rect.Top);
                      Canvas.LineTo(Rect.Left+i, Rect.Bottom);
                    end;
      fdDiagonal:   begin
                      Canvas.MoveTo(i, Rect.Top);
                      Canvas.LineTo(Rect.Left, i);
                    end;
    end;
    CrrR:= CrrR + IncR;
    CrrG:= CrrG + IncG;
    CrrB:= CrrB + IncB;
  end;
end;

function TXiTrackBar.PointInRect(X, Y: Integer; R: TRect): Boolean;
begin
  if (X > R.Left) and (X < R.Right) and (Y > R.Top) and (Y < R.Bottom) then
    Result:= true
  else
    Result:= false;
end;


end.