fctrackbar.pas

一套及时通讯的原码

            Width:= ThumbThickness
       end
       else begin
         if TrackBmp.Empty then
            Height:= ThumbThickness
       end
    end;
    Invalidate;
  end;
end;

procedure TfcTrackBar.SetSliderVisible(Value: Boolean);
begin
  if FSliderVisible <> Value then
  begin
    FSliderVisible := Value;
    Invalidate;
//    RecreateWnd;
  end;
end;

procedure TfcTrackBar.UpdateSelection;
begin
   Invalidate;
end;

procedure TfcTrackBar.SetSelStart(Value: Double);
begin
  if Value <> FSelStart then
  begin
    FSelStart := Value;
    UpdateSelection;
  end;
end;

procedure TfcTrackBar.SetSelEnd(Value: Double);
begin
  if Value <> FSelEnd then
  begin
    FSelEnd := Value;
    UpdateSelection;
  end;
end;

procedure TfcTrackBar.Changed;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TfcTrackBar.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  {$ifdef fcUseThemeManager}
  if fcUseThemes(self) then
  begin
{    R := ClientRect;
    if Focused and ((Perform(WM_QUERYUISTATE, 0, 0) and UISF_HIDEFOCUS) = 0) then
      InflateRect(R, -1, -1);
    ThemeServices.DrawParentBackground(Handle, Message.DC, nil, False, @R);}
    Message.Result := 1;
  end
  else
  {$endif}
     inherited;
end;

function TfcTrackBar.GetDataSource: TDataSource;
begin
  if (FDataLink<>Nil) and (FDataLink.DataSource is TDataSource) then begin
     Result := FDataLink.DataSource as TDataSource
  end
  else Result:= Nil;
end;

procedure TfcTrackBar.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then begin
    Value.FreeNotification(Self);
  end
end;

function TfcTrackBar.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TfcTrackBar.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

procedure TfcTrackBar.DataChange(Sender: TObject);
var Value: Double;
begin
  if FDataLink.Field <> nil then
  begin
//    Position:= FDataLink.Field.asInteger;
    Value := FDataLink.Field.asFloat;

    // Round to multiple of Increment
//    Value:= Round(Value / Increment) * Increment;
    SkipEdit:= True;
    try
      Position:= Value;
    finally
      SkipEdit:= False;
    end;
//    if (DataSource<>nil) and (DataSource.State=dsBrowse) then Modified:=False;
  end
end;

procedure TfcTrackBar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TfcTrackBar.GetField: TField;
begin
  Result := FDataLink.Field;
end;

// For double buffering
procedure TfcTrackBar.WMPaint(var Message: TWMPaint);
var
    DC, MemDC: HDC;
    MemBitmap, OldBitmap: HBITMAP;
    PS: TPaintStruct;
    UpdateRect: TRect;
begin
  windows.GetUpdateRect(Handle, UpdateRect, false);
  if (Message.DC <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Message);
  end
  else begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, inherited GetClientRect.Bottom);
    ReleaseDC(0, DC);

    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
      Message.DC := MemDC;
      if not (csCustomPaint in ControlState) and (ControlCount = 0) then
        inherited
      else
        PaintHandler(Message);
      Message.DC := 0;

      BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Right-UpdateRect.Left,
                 UpdateRect.Bottom-UpdateRect.Top, MemDC, UpdateRect.Left, UpdateRect.top, SRCCOPY);
      EndPaint(Handle, PS);

    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;


end;


function TfcTrackBar.GetTrackBarRect: TRect;
const TickSpace = 7;
begin
  if Orientation = trfcVertical then
  begin
     if TickMarks in [tmfcBoth, tmfcTopLeft] then
     begin
        result:=  Rect(
            SpacingEdgeTrackbar + FThumbTrackSeparation + TickSpace,
            FSpacingLeftTop + TrackButton.Height div 2,
            SpacingEdgeTrackbar + FThumbTrackSeparation + TickSpace + ThumbLength -
            (2 * FThumbTrackSeparation),
            Height-(FSpacingRightBottom+TrackButton.Height div 2))
     end
     else if TickMarks = tmfcBottomRight then
     begin
        result:=  Rect(
            SpacingEdgeTrackbar + FThumbTrackSeparation,
            FSpacingLeftTop + TrackButton.Height div 2,
            SpacingEdgeTrackbar + FThumbTrackSeparation + ThumbLength -
            (2 * FThumbTrackSeparation),
            Height-(FSpacingRightBottom+TrackButton.Height div 2))
     end
  end
  else begin
     if TickMarks in [tmfcBoth, tmfcTopLeft] then
        result:=  Rect(
            FSpacingLeftTop + TrackButton.Width div 2,
            SpacingEdgeTrackbar + FThumbTrackSeparation + TickSpace,
            Width-(FSpacingRightBottom+TrackButton.Width div 2),
            SpacingEdgeTrackbar + FThumbTrackSeparation + TickSpace + ThumbLength -
            (2 * FThumbTrackSeparation))
     else
        result:=  Rect(FSpacingLeftTop + TrackButton.Width div 2,
            SpacingEdgeTrackbar + FThumbTrackSeparation,
            Width-(FSpacingRightBottom+TrackButton.Width div 2),
            SpacingEdgeTrackbar + FThumbTrackSeparation + ThumbLength -
            (2 * FThumbTrackSeparation))
  end
end;

procedure DrawFocusRect(ACanvas: TCanvas; ARect: TRect);
begin
    ACanvas.Brush.Color := clWhite;
    ACanvas.Font.Color := clBlack;
    ACanvas.DrawFocusRect(ARect);
end;


procedure TfcTrackBar.PaintThumb(ALeft, ATop: integer);
var
    ThumbRect: TRect;
    DiagonalHeight: integer;
    Triangle: array[0..2] of TPoint;
    {$ifdef fcUseThemeManager}
    tempRect: TRect;
    Details: TThemedElementDetails;
    {$endif}

    {$ifdef fcUseThemeManager}
      function IsHotThumb: boolean;
      var SP, MousePos: TPoint;
      begin
          GetCursorPos(MousePos);
          sp:= ScreenToClient(MousePos);
          if (sp.x>=ALeft) and (sp.x<=ALeft+TrackButton.Width) and
             (sp.y>=ATop) and (sp.y<=ATop+TrackButton.Height) then
             result:= True
          else result:= False;
      end;

    Function GetThumbTheme: TThemedTrackBar;
    begin
       if not Enabled then
       begin
         if orientation = trfcHorizontal then
         begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbDisabled
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbBottomDisabled
           else
             Result:= ttbThumbTopDisabled
         end
         else begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbVertDisabled
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbRightDisabled
           else
             Result:= ttbThumbLeftDisabled
         end;
       end
       else if TrackButton.DraggingThumb then
       begin
         if orientation = trfcHorizontal then
         begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbPressed
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbBottomPressed
           else
             Result:= ttbThumbTopPressed
         end
         else begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbVertPressed
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbRightPressed
           else
             Result:= ttbThumbLeftPressed
         end;
       end
       else if IsHotThumb then
       begin
         if orientation = trfcHorizontal then
         begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbHot
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbBottomHot
           else
             Result:= ttbThumbTopHot
         end
         else begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbVertHot
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbRightHot
           else
             Result:= ttbThumbLeftHot
         end;
       end
       else if Focused then
       begin
         if orientation = trfcHorizontal then
         begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbFocused
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbBottomFocused
           else
             Result:= ttbThumbTopFocused
         end
         else begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbVertFocused
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbRightFocused
           else
             Result:= ttbThumbLeftFocused
         end;
       end
       else begin
         if orientation = trfcHorizontal then
         begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbNormal
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbBottomNormal
           else
             Result:= ttbThumbTopNormal
         end
         else begin
           if TickMarks = tmfcBoth then
             Result:= ttbThumbVertNormal
           else if TickMarks = tmfcBottomRight then
             Result:= ttbThumbRightNormal
           else
             Result:= ttbThumbLeftNormal
         end;
       end
    end;
    {$endif}
begin
   if not SliderVisible then exit;

   if not TrackThumbIcon.Empty then
   begin
     with TrackThumbIcon do
     begin
        TransparentMode := tmAuto;
        Transparent:= True;
     end;
     Canvas.Draw(ALeft, ATop, TrackThumbIcon);
     exit;
   end;

   {$ifdef fcUseThemeManager}
   if fcUseThemes(self) then
   begin
      tempRect:= TrackButton.ClientRect;
      tempRect.left:= ALeft;
      tempRect.Top:= ATop;
      tempRect.Right:= tempRect.Left + TrackButton.Width;
      tempRect.Bottom:= tempRect.Top + TrackButton.height;
      Details := ThemeServices.GetElementDetails(GetThumbTheme);
      ThemeServices.DrawElement(Canvas.Handle, Details, tempRect);
      exit;
   end;
   {$endif}


   if orientation = trfcHorizontal then
   begin
     with Canvas do begin
        ThumbRect.Left:= ALeft;
        ThumbRect.Right:= ThumbRect.Left + TrackButton.ClientWidth;
        DiagonalHeight:= (ThumbRect.Right-ThumbRect.Left) div 2;
        ThumbRect.Top:= ATop; //RulerRect.Top - Trackbar.FThumbTrackSeparation;
        ThumbRect.Bottom:= ThumbRect.Top + ThumbLength -  DiagonalHeight;
        Brush.Color:= ThumbColor;
        FillRect(ThumbRect);
        DrawEdge(Handle, ThumbRect, EDGE_RAISED,//BDR_RAISEDINNER,
           BF_TOP or BF_LEFT);
        DrawEdge(Handle, ThumbRect, EDGE_RAISED,//BDR_RAISEDINNER,
           BF_RIGHT);
        ThumbRect.Top:= ThumbRect.Bottom;
        ThumbRect.Bottom:= ThumbRect.top + DiagonalHeight;
        ThumbRect.Right:= ThumbRect.Left+ DiagonalHeight;
        DrawEdge(Handle, ThumbRect, EDGE_RAISED,//BDR_RAISEDINNER,
           BF_MIDDLE OR BF_DIAGONAL_ENDTOPLEFT);

        Triangle[0]:= Point(ThumbRect.Left+1, ThumbRect.Top);
        Triangle[1]:= Point(ThumbRect.Right, ThumbRect.Top);
        Triangle[2]:= Point(ThumbRect.Right, ThumbRect.Bottom-1);
        Pen.Color:=ThumbColor;
        Pen.Color:=ThumbColor;
        Brush.Color:= ThumbColor;
        Polygon(Triangle);