cxtrackbar.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,699 行 · 第 1/5 页

destructor TcxCustomTrackBarViewInfo.Destroy;
begin
  FreeAndNil(FTBBitmap);
  FreeAndNil(FTBCanvas);
  FreeAndNil(FLookAndFeel);
  inherited Destroy;
end;

procedure TcxCustomTrackBarViewInfo.Assign(Source: TObject);
begin
  inherited Assign(Source);
  if Source is TcxCustomTrackBarViewInfo then
    with Source as TcxCustomTrackBarViewInfo do
    begin
      Self.LookAndFeel.Assign(LookAndFeel);
      Self.Position := Position;
      Self.TrackSize := TrackSize;
      Self.ThumbWidth := ThumbWidth;
      Self.ThumbHeight := ThumbHeight;
      Self.TrackBarBorderWidth := TrackBarBorderWidth;
      Self.TrackBarState := TrackBarState;
      Self.SelectionStart := SelectionStart;
      Self.SelectionEnd := SelectionEnd;
    end;
end;

function TcxCustomTrackBarViewInfo.GetUpdateRegion(AViewInfo: TcxContainerViewInfo): TcxRegion;
begin
  Result := inherited GetUpdateRegion(AViewInfo);
  if not (AViewInfo is TcxCustomTrackBarViewInfo) then Exit;
end;

function TcxCustomTrackBarViewInfo.IsHotTrack: Boolean;
begin
  Result := True;
end;

function TcxCustomTrackBarViewInfo.IsHotTrack(P: TPoint): Boolean;
begin
  Result := True;
end;

function TcxCustomTrackBarViewInfo.NeedShowHint(ACanvas: TcxCanvas;
  const P: TPoint; out AText: TCaption; out AIsMultiLine: Boolean;
  out ATextRect: TRect): Boolean;
begin
  Result := False;
end;

procedure TcxCustomTrackBarViewInfo.DrawText(ACanvas: TcxCanvas);
begin
  {Dummy}
end;

procedure TcxCustomTrackBarViewInfo.Offset(DX, DY: Integer);
begin
  inherited Offset(DX, DY);
  OffsetRect(RealTrackBarRect, DX, DY);
end;

procedure TcxCustomTrackBarViewInfo.Paint(ACanvas: TcxCanvas);

  procedure FillBackground;
  var
    AIsCustomBackground: Boolean;
  begin
    if IsInplace then
    begin
      if Transparent then
        BitBlt(FTBCanvas.Canvas.Handle, 0, 0, FTBBitmap.Width, FTBBitmap.Height,
          ACanvas.Handle, Bounds.Left, Bounds.Top, SRCCOPY)
      else
      begin
        FTBCanvas.WindowOrg := Bounds.TopLeft;
        try
          AIsCustomBackground := DrawBackground(FTBCanvas);
        finally
          FTBCanvas.WindowOrg := Point(0, 0);
        end;
        if not AIsCustomBackground then
        begin
          FTBCanvas.Brush.Color := BackgroundColor;
          FTBCanvas.FillRect(Rect(0, 0, FTBBitmap.Width, FTBBitmap.Height));
        end;
      end;
    end
    else
      if Edit.Transparent or NativeStyle or (Painter <> nil) then
        cxDrawTransparentControlBackground(Edit, FTBCanvas, Bounds)
      else
        DrawCustomEdit(FTBCanvas, Self, True, bpsSolid);
  end;

var
  APrevClipRgn: TcxRegion;
begin
  FTBBitmap.Width := RectWidth(Bounds);
  FTBBitmap.Height := RectHeight(Bounds);

  FillBackground;

  APrevClipRgn := FTBCanvas.GetClipRegion;
  try
    FTBCanvas.SetClipRegion(TcxRegion.Create(TrackBarRect), roSet);
    PaintTrackBar(FTBCanvas);
  finally
    FTBCanvas.SetClipRegion(APrevClipRgn, roSet);
  end;
  BitBlt(ACanvas.Canvas.Handle, Bounds.Left, Bounds.Top,
    FTBBitmap.Width, FTBBitmap.Height,
    FTBCanvas.Handle, 0, 0, SRCCOPY);
end;

procedure TcxCustomTrackBarViewInfo.PaintTrackBar(ACanvas: TcxCanvas);
var
  AEditProperties: TcxCustomTrackBarProperties;
begin
  AEditProperties := TcxCustomTrackBarProperties(EditProperties);
  if AEditProperties.ShowTrack then
  begin
    DrawTrack(ACanvas);
    if FShowSelection then
      DrawSelection(ACanvas);
  end;
  if AEditProperties.ShowTicks then
    DrawTicks(ACanvas);
  case AEditProperties.ThumbType of
    cxttRegular:
      DrawThumb(ACanvas);
    cxttCustom:
      AEditProperties.DoDrawThumb(Self, ACanvas, ThumbRect);
  end;
end;

procedure TcxCustomTrackBarViewInfo.DrawTrack(ACanvas: TcxCanvas);
var
  FEdgeTrackRect: TRect;
  FTheme: TdxTheme;
  FTrackThemeType: Byte;
begin
  FEdgeTrackRect := TrackRect;
  if Painter <> nil then
    Painter.DrawTrackBar(ACanvas, FEdgeTrackRect, SelectionRect, FShowSelection,
      Enabled, TcxCustomTrackBarProperties(EditProperties).Orientation = tboHorizontal)
  else
    if AreVisualStylesMustBeUsed(LookAndFeel.NativeStyle, totTrackBar) then
    begin
      FTheme := OpenTheme(totTrackBar);
      if TcxCustomTrackBarProperties(EditProperties).Orientation = tboHorizontal then
        FTrackThemeType := TKP_TRACK
      else
        FTrackThemeType := TKP_TRACKVERT;
      DrawThemeBackground(FTheme, ACanvas.Handle, FTrackThemeType, FTrackBarState,
        FEdgeTrackRect);
    end
    else
    begin
      cxEditFillRect(ACanvas, FEdgeTrackRect, TcxCustomTrackBarProperties(EditProperties).TrackColor);
      Dec(FEdgeTrackRect.Right);
      case LookAndFeel.Kind of
        lfStandard:
        begin
          FEdgeTrackRect := DrawBounds(ACanvas, FEdgeTrackRect, clBtnShadow, clBtnHighlight);
          FEdgeTrackRect := DrawBounds(ACanvas, FEdgeTrackRect, cl3DDkShadow, cl3DLight);
        end;
        lfFlat:
        begin
          FEdgeTrackRect := DrawBounds(ACanvas, FEdgeTrackRect, clBtnShadow, clBtnHighlight);
          FEdgeTrackRect := DrawBounds(ACanvas, FEdgeTrackRect, clBtnFace, clBtnFace);
        end;
        lfUltraFlat, lfOffice11:
          FEdgeTrackRect := DrawBounds(ACanvas, FEdgeTrackRect, clWindowFrame, clWindowFrame);
      end;
    end;
end;

procedure TcxCustomTrackBarViewInfo.DrawSelection(ACanvas: TcxCanvas);
begin
  if Painter = nil then
    cxEditFillRect(ACanvas, SelectionRect,
      TcxCustomTrackBarProperties(EditProperties).SelectionColor);
end;

procedure TcxCustomTrackBarViewInfo.DrawTicks(ACanvas: TcxCanvas);
var
  I, X, Y, FDeltaTopLeft, FDeltaX, FDeltaY: Integer;
  FCalcTickSize: Integer;
  FFrequencyCondition: Boolean;
  FTickAsLine: Boolean;
  FTextWidth, FTextHeight: Integer;
  FLocalFont: TFont;
  FTM: TTextMetric;
  FLF: TLogFont;

  procedure PrepareIndirectFont(const Angle: Integer);
  begin
    FLocalFont := TFont.Create;
    FLocalFont.Assign(Font);
    GetTextMetrics(FLocalFont.Handle, FTM);
    if (FTM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
      FLocalFont.Name := 'Arial';
    cxGetFontData(FLocalFont.Handle, FLF);
    FLF.lfEscapement := Angle * 10;
    ACanvas.Font.Handle := CreateFontIndirect(FLF);
  end;

  procedure RemoveIndirectFont;
  begin
    FLF.lfEscapement := 0;
    ACanvas.Font.Handle := CreateFontIndirect(FLF);
    FLocalFont.Free;
  end;

  function DrawTickAsLine(ATickValue: Integer): Boolean;
  var
    AEditProperties: TcxCustomTrackBarProperties;
  begin
    AEditProperties := TcxCustomTrackBarProperties(EditProperties);
    Result := (AEditProperties.TickType = tbttTicks) or ((AEditProperties.TickType = tbttValueNumber) and
      not ((ATickValue = AEditProperties.Min) or (ATickValue = AEditProperties.Max) or (ATickValue = Position)));
  end;

  function GetBounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  begin
  {$IFDEF DELPHI6}
    Result := Types.Bounds(ALeft, ATop, AWidth, AHeight);
  {$ELSE}
    Result := Classes.Bounds(ALeft, ATop, AWidth, AHeight);
  {$ENDIF}
  end;

var
  AEditProperties: TcxCustomTrackBarProperties;
begin
  AEditProperties := TcxCustomTrackBarProperties(EditProperties);
  ACanvas.Font.Assign(Font);
  ACanvas.Brush.Color := clBtnFace;
  if Painter <> nil then
  begin
    ACanvas.Font.Color := Painter.TrackBarTicksColor(True);
    ACanvas.Pen.Color := Painter.TrackBarTicksColor(False);
  end
  else
  begin
    ACanvas.Font.Color := TextColor;
    ACanvas.Pen.Color := TickColor;
  end;
  
  if AEditProperties.TextOrientation = tbtoVertical then PrepareIndirectFont(90);
  try
    if AEditProperties.Orientation = tboVertical then
    begin
      for I := AEditProperties.Min to AEditProperties.Max do
      begin
        Y := Trunc(TickOffset * (I - AEditProperties.Min)) + TrackRect.Top + (ThumbSize div 2);
        FTickAsLine := DrawTickAsLine(I);
        FCalcTickSize := AEditProperties.TickSize;
        if (I = AEditProperties.Min) or (I = AEditProperties.Max) then FCalcTickSize := FCalcTickSize + (AEditProperties.TickSize div 2);
        FFrequencyCondition := (I = AEditProperties.Min) or (I = AEditProperties.Max) or ((AEditProperties.Frequency > 0) and ((I mod AEditProperties.Frequency) = 0));
        if not FFrequencyCondition then Continue;
        if not FTickAsLine then
        begin
          FTextWidth := ACanvas.TextWidth(IntToStr(I));
          FTextHeight := ACanvas.TextHeight(IntToStr(I));
          if AEditProperties.TextOrientation = tbtoVertical then
          begin
            FDeltaTopLeft := FTextWidth div 2;
            FDeltaX := FTextHeight;
          end
          else
          begin
            FDeltaTopLeft := -(FTextHeight div 2);
            FDeltaX := FTextWidth;
          end;
          SetBkMode(ACanvas.Handle, Windows.Transparent);
          if AEditProperties.TickMarks in [cxtmBottomRight, cxtmBoth] then
            ACanvas.DrawText(IntToStr(I), GetBounds(ThumbRect.Right + BetweenTrackAndTick + 1,
              Y + FDeltaTopLeft, FTextWidth + 2, FTextHeight + 2), 0, True);
          if AEditProperties.TickMarks in [cxtmTopLeft, cxtmBoth] then
            ACanvas.DrawText(IntToStr(I), GetBounds(ThumbRect.Left - BetweenTrackAndTick - FDeltaX,
              Y + FDeltaTopLeft, FTextWidth + 2, FTextHeight + 2), 0, True);
        end
        else
        begin
          if AEditProperties.TickMarks in [cxtmBottomRight, cxtmBoth] then
          begin
            ACanvas.MoveTo(ThumbRect.Right + BetweenTrackAndTick + 1, Y);
            ACanvas.LineTo(ThumbRect.Right + BetweenTrackAndTick + FCalcTickSize + 1, Y);
          end;
          if AEditProperties.TickMarks in [cxtmTopLeft, cxtmBoth] then
          begin
            ACanvas.MoveTo(ThumbRect.Left - (BetweenTrackAndTick + FCalcTickSize), Y);
            ACanvas.LineTo(ThumbRect.left - BetweenTrackAndTick, Y);
          end;
        end;
      end;
    end
    else
    begin
      for I := AEditProperties.Min to AEditProperties.Max do
      begin
        X := Trunc(TickOffset * (I - AEditProperties.Min)) + TrackRect.Left + (ThumbSize div 2);
        FTickAsLine := DrawTickAsLine(I);
        FCalcTickSize := AEditProperties.TickSize;
        if (I = AEditProperties.Min) or (I = AEditProperties.Max) then FCalcTickSize := FCalcTickSize + (AEditProperties.TickSize div 2);
        FFrequencyCondition := (I = AEditProperties.Min) or (I = AEditProperties.Max) or ((AEditProperties.Frequency > 0) and ((I mod AEditProperties.Frequency) = 0));
        if not FFrequencyCondition then Continue;
        if not FTickAsLine then
        begin
          FTextWidth := ACanvas.TextWidth(IntToStr(I));
          FTextHeight := ACanvas.TextHeight(IntToStr(I));
          if AEditProperties.TextOrientation = tbtoVertical then
          begin
            FDeltaTopLeft := (FTextHeight div 2) - 1;
            FDeltaX := FTextWidth;
            FDeltaY := 0;
          end
          else
          begin
            FDeltaTopLeft := (FTextWidth div 2);
            FDeltaX := 0;
            FDeltaY := FTextHeight;
          end;
          SetBkMode(ACanvas.Handle, Windows.Transparent);
          if AEditProperties.TickMarks in [cxtmBottomRight, cxtmBoth] then
            ACanvas.DrawText(IntToStr(I), GetBounds(X - FDeltaTopLeft,
              ThumbRect.Bottom + BetweenTrackAndTick + FDeltaX, FTextWidth + 2, FTextHeight + 2), 0, True);
          if AEditProperties.TickMarks in [cxtmTopLeft, cxtmBoth] then
            ACanvas.DrawText(IntToStr(I), GetBounds(X - FDeltaTopLeft,
              ThumbRect.Top - (BetweenTrackAndTick + FDeltaY), FTextWidth + 2, FTextHeight + 2), 0, True);
        end
        else
        begin
          if AEditProperties.TickMarks in [cxtmBottomRight, cxtmBoth] then
          begin
            ACanvas.MoveTo(X, ThumbRect.Bottom + BetweenTrackAndTick + 1);
            ACanvas.LineTo(X, ThumbRect.Bottom + BetweenTrackAndTick + FCalcTickSize + 1);
          end;
          if AEditProperties.TickMarks in [cxtmTopLeft, cxtmBoth] then
          begin