strackbar.pas

Alpha Controls.v5.46b Source

  if TickStyle <> tsNone then begin
    pa := TicksArray;
    cr := ChannelRect;
    mh := (HeightOf(ThumbRect) - HeightOf(cr)) div 2 + 2;
    if TickMarks in [tmTopLeft, tmBoth]
      then for i := 0 to High(pa) do PaintTick(Point(pa[i].x, cr.Top - mh - TickHeight), True);
    if TickMarks in [tmBottomRight, tmBoth]
      then for i := 0 to High(pa) do PaintTick(Point(pa[i].x, cr.Bottom + mh), True);
  end;
end;

procedure TsTrackBar.PaintThumb(i: integer);
var
  aRect, NewRect : TRect;
  Bmp : TBitmap;
  md : TsMaskData;
  function NotStretched : boolean; begin
    Result := False;
    with SkinData.SkinManager do begin
      if Orientation = trHorizontal then begin
        if (HeightOf(aRect) = HeightOf(ma[i].R) div (ma[i].MaskType + 1)) and (WidthOf(aRect) = WidthOf(ma[i].R) div ma[i].ImageCount) then Result := True;
        if (HeightOf(aRect) = 23) and (HeightOf(ma[i].R) div (ma[i].MaskType + 1) = 21) and (WidthOf(aRect) = 11) then Result := True;
      end
      else begin
        if (HeightOf(aRect) = HeightOf(ma[i].R) div (ma[i].MaskType + 1)) and (WidthOf(aRect) = WidthOf(ma[i].R) div ma[i].ImageCount) then Result := True;
        if (WidthOf(aRect) = 23) and (WidthOf(ma[i].R) div ma[i].ImageCount = 21) and (HeightOf(aRect) = 11) then Result := True;
      end;
    end;
  end;
  procedure RotateBmp180(Bmp : TBitmap; Horz : boolean);
  var
    x, y : integer;
    c : TColor;
  begin
    if not Horz then begin
      for x := 0 to Bmp.Width - 1 do for y := 0 to (Bmp.Height - 1) div 2 do begin
        c := Bmp.Canvas.Pixels[x, y];
        Bmp.Canvas.Pixels[x, y] := Bmp.Canvas.Pixels[x, Bmp.Height - y - 1];
        Bmp.Canvas.Pixels[x, Bmp.Height - y - 1] := c
      end;
    end
    else begin
      for y := 0 to Bmp.Height - 1 do for x := 0 to (Bmp.Width - 1) div 2 do begin
        c := Bmp.Canvas.Pixels[x, y];
        Bmp.Canvas.Pixels[x, y] := Bmp.Canvas.Pixels[Bmp.Width - x - 1, y];
        Bmp.Canvas.Pixels[Bmp.Width - x - 1, y] := c
      end;
    end;
  end;
begin
  aRect := ThumbRect;

  if Orientation = trHorizontal
    then i := SkinData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_SliderHorzMask)
    else i := SkinData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_SliderVertMask);
  if SkinData.SkinManager.IsValidImgIndex(i) then with SkinData.SkinManager do begin
    if NotStretched then begin
      if TickMarks = tmTopLeft then begin
        Bmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
        try
          BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, SRCCOPY);
          RotateBmp180(Bmp, Orientation <> trHorizontal);
          DrawSkinGlyph(Bmp, Point(0, 0), Mode, 1, ma[i]);
          RotateBmp180(Bmp, Orientation <> trHorizontal);
          BitBlt(FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
        finally
          Bmp.Free;
        end
      end
      else DrawSkinGlyph(FCommonData.FCacheBmp, point(aRect.Left, aRect.Top), Mode, 1, ma[i])
    end
    else if MasterBitmap <> nil then begin
      NewRect := Rect(0, 0, WidthOf(aRect), HeightOf(aRect)); NewRect.Right := NewRect.Right * 3; NewRect.Bottom := NewRect.Bottom * (ma[i].MaskType + 1);
      Bmp := CreateBmp24(WidthOf(NewRect), HeightOf(NewRect));
      if ma[i].MaskType = 0 then begin
        StretchBlt(Bmp.Canvas.Handle, 0, 0, WidthOf(NewRect),
                   HeightOf(NewRect), MasterBitmap.Canvas.Handle,
                   ma[i].R.Left, ma[i].R.Top, WidthOf(ma[i].R), HeightOf(ma[i].R), SRCCOPY);
      end
      else begin
        StretchBlt(Bmp.Canvas.Handle,
                   0, 0, WidthOf(NewRect), HeightOf(aRect), MasterBitmap.Canvas.Handle,
                   ma[i].R.Left, ma[i].R.Top, WidthOf(ma[i].R), HeightOf(ma[i].R) div 2, SRCCOPY);

        StretchBlt(Bmp.Canvas.Handle,
                   0, HeightOf(aRect), WidthOf(NewRect), Bmp.Height, MasterBitmap.Canvas.Handle,
                   ma[i].R.Left, ma[i].R.Top + HeightOf(ma[i].R) div 2, WidthOf(ma[i].R), HeightOf(ma[i].R), SRCCOPY);
      end;
      md.Bmp := Bmp;
      md.BorderWidth := 0;
      md.MaskType := ma[i].MaskType;
      md.ImageCount := ma[i].ImageCount;
      md.R := Rect(0, 0, Bmp.Width, Bmp.Height);

      DrawSkinGlyph(FCommonData.FCacheBmp, point(aRect.Left, aRect.Top), Mode, 1, md);

      FreeAndNil(Bmp);
    end;
  end;
end;

function TsTrackBar.ThumbRect: TRect;
begin
  Result := Rect(0, 0, 1, 1);
  SendMessage(Handle, TBM_GETTHUMBRECT, 0, longint(@Result));
end;

function TsTrackBar.ChannelRect: TRect;
begin
  Result := Rect(0, 0, 1, 1);
  SendMessage(Handle, TBM_GETCHANNELRECT, 0, longint(@Result));
  if Orientation = trVertical then begin
    Changei(Result.Left, Result.Top);
    Changei(Result.Right, Result.Bottom);
  end;
end;

function TsTrackBar.TickPos(i: integer): integer;
var
  Value : longint;
begin
  Value := longint(i);
  Result := SendMessage(Handle, TBM_GETTICPOS, Value, 0);
//  Result := Value;
end;

function TsTrackBar.TickCount: integer;
begin
  Result := SendMessage(Handle, TBM_GETNUMTICS, 0, 0);
end;

function TsTrackBar.TicksArray: TAPoint;
var
  i, w, c : integer;
  ChRect, ThRect : TRect;
begin
  Result := nil;
  ChRect := ChannelRect;
  ThRect := ThumbRect;
  c := TickCount;
  SetLength(Result, c);
  if TickStyle = tsAuto then begin
    if Orientation = trVertical then begin
      iStep := (HeightOf(ChRect) - HeightOf(ThRect)) / (TickCount - 1);
      w := HeightOf(ThRect) div 2;
      for i := 0 to c - 1 do Result[i] := Point(0, Round(ChRect.Top + i * iStep + w));
    end
    else begin
      iStep := (WidthOf(ChRect) - WidthOf(ThRect)) / (TickCount - 1);
      w := WidthOf(ThRect) div 2;
      for i := 0 to c - 1 do Result[i] := Point(Round(ChRect.Left + i * iStep + w), 0);
    end;
  end
  else begin
    if Orientation = trVertical then begin
      Result[0] := Point(0, ChRect.Top + HeightOf(ThRect) div 2);
      for i := 0 to c - 3 do Result[i + 1] := Point(0, TickPos(i));
      Result[c - 1] := Point(0, ChRect.Bottom - HeightOf(ThRect) div 2);
    end
    else begin
      Result[0] := Point(ChRect.Left + WidthOf(ThRect) div 2, 0);
      for i := 0 to c - 3 do Result[i + 1] := Point(TickPos(i), 0);
      Result[c - 1] := Point(ChRect.Right - WidthOf(ThRect) div 2, 0);
    end;
  end;
end;

procedure TsTrackBar.PaintTicksVer;
var
  i, mh : integer;
  pa : TAPoint;
  cr : TRect;
begin
  if TickStyle <> tsNone then begin
    pa := TicksArray;
    cr := ChannelRect;
    mh := (WidthOf(ThumbRect) - WidthOf(cr)) div 2 + 2;
    if TickMarks in [tmTopLeft, tmBoth]
      then for i := 0 to High(pa) do PaintTick(Point(cr.Left - mh - TickHeight, pa[i].y), False);
    if TickMarks in [tmBottomRight, tmBoth]
      then for i := 0 to High(pa) do PaintTick(Point(cr.Right + mh, pa[i].y), False);
  end else pa := nil;
end;

procedure TsTrackBar.Paint;
begin
  if (csDestroying in ComponentState) or not FCommonData.Skinned then inherited else begin
    FCommonData.Updating := FCommonData.Updating;
    if not FCommonData.Updating and not (Assigned(FadeTimer) and FadeTimer.Enabled) then begin
      PrepareCache;
      UpdateCorners(FCommonData, 0);
      BitBlt(Canvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
  end;
end;

procedure TsTrackBar.AfterConstruction;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsTrackBar.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsTrackBar.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsTrackBar.UserChanged;
begin
  if Assigned(FOnUserChange) then FOnUserChange(Self);
end;

procedure TsTrackBar.PaintWindow(DC: HDC);
begin
  if FCommonData.Skinned then begin
    if not Assigned(FadeTimer) or (FadeTimer.FDirection = fdNone) then begin
      FCanvas.Lock;
      if DC <> 0 then FCanvas.Handle := DC else GetWindowDC(FCanvas.Handle); 
      try
        TControlCanvas(FCanvas).UpdateTextFlags;
        Paint;
      finally
        if DC = 0 then ReleaseDC(Handle, FCanvas.Handle);
        FCanvas.Handle := 0;
        FCanvas.Unlock;
      end;
    end
  end
  else inherited;
end;

procedure TsTrackBar.PrepareCache;
var
  CI : TCacheInfo;
begin
  FCommonData.InitCacheBmp;
  PaintBody;
  if not Enabled then begin
    CI := GetParentCache(FCommonData);
    BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
  end;
end;

procedure TsTrackBar.PaintTick(P : TPoint; Horz: boolean);
var
  GlyphIndex : integer;
  w : integer;
  R : TRect;
begin
  if Horz
    then GlyphIndex := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_TICKHORZ)
    else GlyphIndex := SkinData.SkinManager.GetMaskIndex(SkinData.SkinIndex, SkinData.SkinSection, s_TICKVERT);
  if GlyphIndex <> -1 then begin
    if Horz
      then dec(P.x, WidthOf(SkinData.SkinManager.ma[GlyphIndex].R) div (2 * SkinData.SkinManager.ma[GlyphIndex].ImageCount))
      else dec(P.y, HeightOf(SkinData.SkinManager.ma[GlyphIndex].R) div (2 * (1 + SkinData.SkinManager.ma[GlyphIndex].MaskType)));
    DrawSkinGlyph(SkinData.FCacheBmp, P, Mode, 1, SkinData.SkinManager.ma[GlyphIndex])
  end
  else begin
    if Horz
      then R := Rect(P.x, P.y, P.x + 2, P.Y + TickHeight)
      else R := Rect(P.x, P.y, P.x + TickHeight, P.Y + 2);
    w := 1;
    DrawRectangleOnDC(FCommonData.FCacheBmp.Canvas.Handle, R, ColorToRGB(clBtnShadow), ColorToRGB(clWhite), w);
  end;
end;

function TsTrackBar.Mode: integer;
begin
  if (csLButtonDown in ControlState) //and PtInRect(ThumbRect, ScreenToClient(Mouse.CursorPos))
    then Result := 2
    else if ControlIsActive(FCommonData) then Result := 1 else Result := 0;
end;

procedure TsTrackBar.SetShowFocus(const Value: boolean);
begin
  FShowFocus := Value;
  if FShowFocus <> Value then FCommonData.Invalidate;
end;

end.