fcscrollbar.pas

一套及时通讯的原码

    {$endif}
    PUSHED: array[Boolean] of Integer = (0, DFCS_FLAT or DFCS_PUSHED);
    {$ifdef fcUseThemeManager}
  var
     Details: TThemedElementDetails;
     pt: TPoint;
     Hot: boolean;
     {$endif}
  begin
     if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
     begin
       {$ifdef fcUseThemeManager}
        GetCursorPos(pt);
        pt := ScreenToClient(pt);
        Hot:= (PtInRect(Rect,pt));

        if Down then
           Details := ThemeServices.GetElementDetails(ThemedPressedScrollDirections[Direction])
        else if not Hot then
           Details := ThemeServices.GetElementDetails(ThemedScrollDirections[Direction])
        else
           Details := ThemeServices.GetElementDetails(ThemedHotScrollDirections[Direction]);

        ThemeServices.DrawElement(Canvas.Handle, Details, Rect);
       {$endif}
     end
     else begin
        DrawFrameControl(Canvas.Handle, Rect, DFC_SCROLL, SCROLLDIRECTIONS[Direction] or PUSHED[Down]);
     end;
  end;

  procedure PaintClient(Rect: TRect; Down: Boolean);
  var ACursor: TPoint;
      {$ifdef fcUseThemeManager}
      Details: TThemedElementDetails;
      {$endif}
  begin
      GetCursorPos(ACursor);
      ACursor := ScreenToClient(ACursor);
      if Down and (GetHitTestInfo(ACursor.X, ACursor.Y)=FClickedPos) then
      begin
         if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
         begin
           {$ifdef fcUseThemeManager}
            if Kind=sbVertical then
              Details := ThemeServices.GetElementDetails(tsLowerTrackVertPressed)
            else
              Details := ThemeServices.GetElementDetails(tsLowerTrackHorzPressed);
            ThemeServices.DrawElement(Canvas.Handle, Details, Rect);
            {$endif}
         end
         else begin
            fcDither(Canvas, Rect, clBlack, RGB(64,64,64));
         end;
         exit;
      end
      else if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
      begin
        {$ifdef fcUseThemeManager}
         if Kind=sbVertical then
            Details := ThemeServices.GetElementDetails(tsLowerTrackVertNormal)
         else
            Details := ThemeServices.GetElementDetails(tsLowerTrackHorzNormal);
         ThemeServices.DrawElement(Canvas.Handle, Details, Rect);
         {$endif}
      end
      else fcDither(Canvas, Rect, clBtnFace, clWhite);
  end;

  procedure PaintThumb(Rect: TRect);

    {$ifdef fcUseThemeManager}
  var
     Details: TThemedElementDetails;
     pt: TPoint;
     Hot: boolean;
     {$endif}
  begin
     if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
     begin
       {$ifdef fcUseThemeManager}
        if Kind=sbVertical then
           Rect.Top:= Rect.Top - 1
        else begin
           Rect.Left:= Rect.Left - 1;
        end;

        GetCursorPos(pt);
        pt := ScreenToClient(pt);
        Hot:= (PtInRect(Rect,pt));

        if Kind=sbVertical then
        begin
          if FClickedPos=htThumb then
             Details := ThemeServices.GetElementDetails(tsThumbBtnVertPressed)
          else if not Hot then
             Details := ThemeServices.GetElementDetails(tsThumbBtnVertNormal)
          else
             Details := ThemeServices.GetElementDetails(tsThumbBtnVertHot);
          ThemeServices.DrawElement(Canvas.Handle, Details, Rect);

          if FClickedPos=htThumb then
             Details := ThemeServices.GetElementDetails(tsGripperVertPressed)
          else if not Hot then
             Details := ThemeServices.GetElementDetails(tsGripperVertNormal)
          else
             Details := ThemeServices.GetElementDetails(tsGripperVertHot);
          ThemeServices.DrawElement(Canvas.Handle, Details, Rect);
        end
        else begin
          if FClickedPos=htThumb then
             Details := ThemeServices.GetElementDetails(tsThumbBtnHorzPressed)
          else if not Hot then
             Details := ThemeServices.GetElementDetails(tsThumbBtnHorzNormal)
          else
             Details := ThemeServices.GetElementDetails(tsThumbBtnHorzHot);
          ThemeServices.DrawElement(Canvas.Handle, Details, Rect);

          if FClickedPos=htThumb then
             Details := ThemeServices.GetElementDetails(tsGripperHorzPressed)
          else if not Hot then
             Details := ThemeServices.GetElementDetails(tsGripperHorzNormal)
          else
             Details := ThemeServices.GetElementDetails(tsGripperHorzHot);
          ThemeServices.DrawElement(Canvas.Handle, Details, Rect);
        end;
//    tsGripperHorzNormal, tsGripperHorzHot, tsGripperHorzPressed, tsGripperHorzDisabled,
//    tsGripperVertNormal, tsGripperVertHot, tsGripperVertPressed, tsGripperVertDisabled,
        {$endif}
     end
     else begin
        if Kind=sbVertical then
           Rect.Left:= Rect.Left + 1
        else Rect.Top:= Rect.Top + 1;

        DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH);

        with Rect, Canvas do begin
           Pen.Color := clBtnFace;
           Polyline([Point(Left-1, Bottom-1), Point(Left-1, Top-1), Point(Right+1, Top-1)]);
        end;
     end;

  end;

var IncDir, DecDir: TfcDirection;
begin
  if Kind = sbVertical then
  begin
    IncDir := sbUp;
    DecDir := sbDown;
  end else begin
    IncDir := sbRight;
    DecDir := sbLeft;
  end;

//  if fClickedPos = htPageUp then
//    Screen.cursor:= crArrow;
  if All then
  begin
     PaintButton(GetSectionRect(htIncBtn), IncDir, FClickedPos = htIncBtn);
     PaintButton(GetSectionRect(htDecBtn), DecDir, FClickedPos = htDecBtn);
  end;
  PaintClient(GetSectionRect(htPageUp), FClickedPos=htPageUp);
  PaintClient(GetSectionRect(htPageDown), FClickedPos=htPageDown);
  PaintThumb(GetSectionRect(htThumb));
end;

{ Number of pixels in scroll area, thumb region excluded }
Function TfcCustomScrollBar.ScrollScreenRange: integer;
var ThumbSize: integer;
begin
   if Kind = sbVertical then begin
      if FixedThumbSize then
         ThumbSize:= 16
      else begin
         ThumbSize:= Trunc(PageSize/(Max-Min+incr) * (Height-(GetSectionRect(htDecBtn).Bottom)*2));
         ThumbSize:= fcmax(ThumbSize, MinThumbSize);
      end;
      result:= Height-(GetSectionRect(htDecBtn).Bottom)*2-ThumbSize;
   end
   else begin
      ThumbSize:= Trunc(PageSize/(Max-Min+incr) * (Width-(GetSectionRect(htDecBtn).Right)*2));
      result:= Width-(GetSectionRect(htDecBtn).Right)*2-ThumbSize
   end;
   if result=0 then result:= 1;  { Don't allow 0 }
end;

function TfcCustomScrollBar.HasScrollRange: boolean;
begin
   result:= PageSize<Max-Min+incr;
end;

function TfcCustomScrollBar.GetSectionRect(Section: TfcScrollBarHitTest;
         DeltaX: integer = 0; DeltaY: integer = 0): TRect;
var ThumbSize, StartPos: integer;

    Function ScrollScreenRange: integer;
    begin
       if Kind = sbVertical then
          result:= Height-(GetSectionRect(htDecBtn).Bottom)*2-ThumbSize
       else
          result:= Width-(GetSectionRect(htDecBtn).Right)*2-ThumbSize;
    end;

begin
  if PageSize>=Max-Min+incr then exit;

  case Section of
    htNone: result := Rect(0, 0, 0, 0);
    htThumb: begin
      if FixedThumbSize then
         ThumbSize:= 16
      else begin
         if Kind = sbVertical then begin
            ThumbSize:=
              Trunc(PageSize/(Max-Min+incr) * (Height-(GetSectionRect(htDecBtn).Bottom)*2));
            ThumbSize:= fcmax(ThumbSize, MinThumbSize);
         end
         else
            ThumbSize:= Trunc(PageSize/(Max-Min+incr) * (Width-(GetSectionRect(htDecBtn).Right)*2));
      end;
      if DragOrigPosition>=0 then
         StartPos:= Trunc(((DragOrigPosition-Min)/(Max-Min+incr-PageSize)) * ScrollScreenRange)
      else
         StartPos:= Trunc(((Position-Min)/(Max-Min+incr-PageSize)) * ScrollScreenRange);

      // if Other ScrollBar showing then skip the following line
      AdjustThumb(ThumbSize);

      StartPos:= fcLimit(StartPos+DragOffset, 1, ScrollScreenRange);

      if Kind = sbVertical then
      begin
        if StartPos=1 then begin
          StartPos:= StartPos + GetSectionRect(htDecBtn).bottom;
          result := Rect(0, StartPos, Width, StartPos + ThumbSize-1);
        end
        else begin
          StartPos:= StartPos + GetSectionRect(htDecBtn).bottom;
          result := Rect(0, StartPos, Width, StartPos + ThumbSize);
        end;
      end
      else begin
        if StartPos=1 then begin
          StartPos:= StartPos + GetSectionRect(htDecBtn).Right;
          result := Rect(StartPos, 0, StartPos + ThumbSize-1, Height)
        end
        else begin
          StartPos:= StartPos + GetSectionRect(htDecBtn).Right;
          result := Rect(StartPos, 0, StartPos + ThumbSize, Height)
        end
      end;

    end;
    htIncBtn:
      if Kind = sbVertical then
      begin
         if Height<3*GetSystemMetrics(SM_CYVSCROLL) then
            result := Rect(0,
                       Height-fcMin(GetSystemMetrics(SM_CYVSCROLL), Height div 2),
                       Width, Height)
         else
            result := Rect(0,
                       Height-fcMin(GetSystemMetrics(SM_CYVSCROLL), Height div 3),
                       Width, Height)
      end
      else result := Rect(
                       Width-fcMin(GetSystemMetrics(SM_CXHSCROLL), Width div 3), 0,
                       Width, Height);
    htDecBtn:
      if Kind = sbVertical then
         if Height<3*GetSystemMetrics(SM_CYVSCROLL) then
            result := Rect(0, 0, Width,
                  fcMin(GetSystemMetrics(SM_CYVSCROLL), Height div 2))
         else
            result := Rect(0, 0, Width,
                  fcMin(GetSystemMetrics(SM_CYVSCROLL), Height div 3))
      else result := Rect(0, 0,
                  fcMin(GetSystemMetrics(SM_CXHSCROLL), Width div 3),
                  Height);
    htPageUp:
      if Kind = sbVertical then
        result := Rect(0, GetSectionRect(htThumb).Bottom, Width, GetSectionRect(htIncBtn).Top)
      else result := Rect(GetSectionRect(htThumb).Right, 0, GetSectionRect(htIncBtn).Left, Height);
    htPageDown:
      if Kind = sbVertical then
        result := Rect(0, GetSectionRect(htDecBtn).Bottom, Width, GetSectionRect(htThumb).Top)
      else result := Rect(GetSectionRect(htDecBtn).Right, 0, GetSectionRect(htThumb).Left, Height);
  end;

  result.left:= result.left + deltax;
  result.top:= result.top + deltay;
  result.right:= result.right + deltax;
  result.bottom:= result.bottom + deltay;
end;

function TfcCustomScrollBar.GetHitTestInfo(X, Y: Integer): TfcScrollBarHitTest;
begin
  for result := Low(TfcScrollBarHitTest) to High(TfcScrollBarHitTest) do
    if PtInRect(GetSectionRect(result), Point(x, y)) then Break;
end;

procedure TfcCustomScrollBar.MoveScrollPos;
var OldPos, NewPos: Integer;
begin
  OldPos := FPosition;
  FPriorPosition:= FPosition;
  case FClickedPos of
    htIncBtn: begin
       Position := Position + SmallChange;
       {if OldPos<>Position then }Scroll(SB_LINEDOWN, Position);
    end;

    htDecBtn: begin
       Position := Position - SmallChange;
       {if OldPos<>Position then} Scroll(SB_LINEUP, Position);
    end;

    htPageUp: begin
       Position := Position + PageSize;
       {if OldPos<>Position then }Scroll(SB_PAGEDOWN, Position);
    end;

    htPageDown: begin
       Position := Position - PageSize;
       {if OldPos<>Position then }Scroll(SB_PAGEUP, Position);
    end;

  end;
  NewPos := FPosition;
  ScrollPosChange(OldPos, NewPos);
end;

procedure TfcCustomScrollBar.SetParams(APosition, AMax, AMin: Integer);
begin
  FPosition := APosition;
  FMax := AMax;
  FMin := AMin;
end;

procedure TfcCustomScrollBar.Scroll(ScrollCode: integer; Position: integer);
begin
end;

{procedure TfcCustomScrollBar.WMNCHitTest(var Message: TWMNCHitTest);
begin
  DefaultHandler(Message);
end;
}
procedure TfcCustomScrollBar.CMDesignHitTest(var Message: TCMDesignHitTest);
//var HitTest: TfcHitTests;
begin
{   HitTest:= GetHitTestInfoAt(Message.xPos, Message.yPos);
   if fchtToRight in HitTest then begin
      Message.Result:= 1;
   end
   else }
   message.result:= 1;
//   inherited;
end;

procedure TfcCustomScrollBar.AdjustThumb(var ThumbSize: integer);
begin
end;

procedure TfcCustomScrollBar.WndProc(var Message: TMessage);
begin
  inherited;
end;

procedure TfcCustomScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var MouseMovePos: TfcScrollBarHitTest;
begin
  inherited;

   // Later optimize to only invalidate portion that mouse is over
   // ..And only if we have moved to a new location
  if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
  begin
     MouseMovePos:= GetHitTestInfo(X, Y);
     if FLastMouseMovePos<>MouseMovePos then
     begin
        invalidate;
     end;
     FLastMouseMovePos:= MouseMovePos;
  end;


end;

procedure TfcCustomScrollBar.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if fcuseThemes(self) then //ThemeServices.ThemesEnabled then
  begin
    FLastMouseMovePos:= htNone;
    invalidate;
  end;
end;

procedure TfcCustomScrollBar.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
  begin
    FLastMouseMovePos:= htNone;
    invalidate;
  end;
end;

procedure TfcCustomScrollBar.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
{   if fcUseThemes(self) then
   begin
     Message.result:= 1
   end
   else }inherited;
end;


end.