sscrollbar.pas

AlphaControls是一个Delphi标准控件的集合

    SM_SETNEWSKIN, SM_REFRESH : begin
      Perform(CM_RECREATEWND, 0, 0);
    end
  end;
end;

procedure TsScrollBar.DrawSlider(b: TBitmap);
begin
  Ci.Bmp := b;
  PaintItem(ScrollSliderIndex, SliderSectionName, Ci, True,
    SliderState,
    SliderRect,
    Point(SliderRect.Left, SliderRect.Top), b);
  Ci.Bmp := FCommonData.FCacheBmp;

  i1 := GetMaskIndex(FScrollSliderIndex, SliderSectionName, ItemGlyph);
  if IsValidImgIndex(i1) and
         (((Kind = sbVertical) and (ma[i1].Bmp.Height div 2 < HeightOf(FSliderRect))) or
         ((Kind = sbHorizontal) and (ma[i1].Bmp.Width div 2 < WidthOf(FSliderRect))))
            then begin
    p.x := FSliderRect.Left + (WidthOf(FSliderRect) - ma[i1].Bmp.Width div 3) div 2 + integer(SliderState = 2);
    p.y := FSliderRect.Top + (HeightOf(FSliderRect) - ma[i1].Bmp.Height div 2) div 2 + integer(SliderState = 2);
    PaintRasterGlyph(b, ma[i1].Bmp, p, SliderState, ma[i1].TransparentColor);
  end;
end;

procedure TsScrollBar.WMNCHitTest(var Message: TWMNCHitTest);
var
  i : integer;
begin
  if not ControlIsReady(Self) then Exit;
  if Skinable and Enabled and not (csDesigning in ComponentState) and (Self <> nil) then begin
    if PtInRect(SliderRect, CoordToPoint(SmallPointToPoint(Message.Pos))) or (SliderState = 2) then begin
      if SliderState <> 2 then begin
        SliderState := 1;
      end
      else begin
        i := CoordToPosition(CoordToPoint(Point(Message.Pos.X, Message.Pos.Y))) - MouseOffset;
        if Position <> i then begin
          DrawingForbidden := True;
          Position := i;
        end;
      end;
    end
    else
    if PtInRect(Btn1Rect, CoordToPoint(SmallPointToPoint(Message.Pos))) then begin
      if Btn1State <> 2 then begin
        Btn1State := 1;
      end;
    end
    else if PtInRect(Btn2Rect, CoordToPoint(SmallPointToPoint(Message.Pos))) then begin
      if Btn2State <> 2 then begin
        Btn2State := 1;
      end;
    end
    else if (SliderState = 2) then begin
      i := CoordToPosition(CoordToPoint(SmallPointToPoint(Message.Pos)));
      if Position <> i then begin
        DrawingForbidden := True;
        Position := i;
      end;
    end
    else begin
      SliderState := 0;
      Btn1State := 0;
      Btn2State := 0;
    end;
    if Self <> nil then UpdateBar;
  end;
  inherited;
end;

procedure TsScrollBar.OnBtnTimer(Sender: TObject);
begin
  if not Assigned(Timer) or (csDestroying in Timer.ComponentState) then Exit;
  if Btn1State = 2 then begin
    Position := FPosition - SmallChange;
  end
  else
  if Btn2State = 2 then begin
    Position := FPosition + SmallChange;
  end
  else begin
    if Assigned(Timer) then FreeAndNil(Timer);
  end;
end;

procedure TsScrollBar.PrepareBtnTimer;
begin
  if Assigned(Timer) then FreeAndNil(Timer);
  Timer := TTimer.Create(Self);
  Timer.OnTimer := OnBtnTimer;
  Timer.Interval := 100;
  Timer.Enabled := True;
end;

function TsScrollBar.PositionToCoord: integer;
begin
  if Enabled then begin
    if (Max - Min) <> 0 then
      if Kind = sbHorizontal then begin
        Result := FirstPoint + SliderSize div 2 + Round(Position * ((Width - 2 * FirstPoint - SliderSize) / (Max - Min)));
      end
      else begin
        Result := FirstPoint + SliderSize div 2 + Round(Position * ((Height - 2 * FirstPoint - SliderSize) / (Max - Min)));
      end
    else begin
      Result := 0;
    end;
  end
  else begin
    if Kind = sbHorizontal then begin
      Result := Width div 2;
    end
    else begin
      Result := Height div 2;
    end;
  end;
end;

function TsScrollBar.Skinable: boolean;
begin
  Result := Assigned(sSkinData) and sSkinData.Active;// IsValidSkinIndex(FCommonData.SkinIndex);
end;

procedure TsScrollBar.KeyDown(var Key: word; Shift: TShiftState);
begin
  case Key of
    VK_PRIOR:          Position := Position - LargeChange;
    VK_NEXT:           Position := Position + LargeChange;
    VK_END:            Position := Max;
    VK_HOME:           Position := Min;
    VK_LEFT, VK_UP:    Position := Position - SmallChange;
    VK_RIGHT, VK_DOWN: Position := Position + SmallChange;
  end;
  inherited;
end;

procedure TsScrollBar.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := DLGC_WANTARROWS;
end;

procedure TsScrollBar.WMPaint(var Msg: TMessage);
begin
  inherited;
  if not ((csDestroying in ComponentState) or (csLoading in ComponentState)) and Skinable then begin
    Paint;
    Msg.Result := 1;
  end;
end;

procedure TsScrollBar.WMNCPaint(var Msg: TMessage);
begin
  inherited;
  if Skinable then Msg.Result := 1;
end;

procedure TsScrollBar.CMMouseLeave(var Msg: TMessage);
begin
  if Skinable then begin
    Btn1State := 0;
    Btn2State := 0;
    if SliderState <> 2 then begin
      SliderState := 0;
      Bar1State := 0;
      Bar2State := 0;
    end;
{
    if Assigned(LinkedControl) then begin
      LinkedControl.Perform(CM_MOUSELEAVE, 0, 0);
      LinkedControl.Repaint;
      Application.ProcessMessages;
    end;
}
  {
    if Assigned(ParentSStyle) then begin
      p := ParentSStyle.FOwner.ClientToScreen(Point(ParentSStyle.FOwner.Left, ParentSStyle.FOwner.Top));
      r := Rect(p.x, p.y, p.x + ParentSStyle.FOwner.Width, p.y + ParentSStyle.FOwner.Height);
      p := Mouse.CursorPos;
      if PtInRect(r, p) and ParentSStyle.FMouseAbove then begin
        ParentSStyle.FMouseAbove := False;
        ParentSStyle.Invalidate;
      end;
    end;
  }
    UpdateBar;
  end else inherited;
end;

function TsScrollBar.SliderSectionName: string;
begin
  if Kind = sbHorizontal then begin
    Result := ScrollSlider + 'H';
  end
  else begin
    Result := ScrollSlider + 'V';
  end;
end;

procedure TsScrollBar.PrepareBarTimer;
begin
  if Assigned(Timer) then FreeAndNil(Timer);
  Timer := TTimer.Create(Self);
  Timer.OnTimer := OnBarTimer;
  Timer.Interval := 100;
  Timer.Enabled := True;
end;

procedure TsScrollBar.OnBarTimer(Sender: TObject);
begin
  if not Assigned(Timer) or (csDestroying in Timer.ComponentState) then Exit;
  if (Bar1State = 2) and (Position > CoordToPosition(ScreenToClient(Mouse.CursorPos))) then begin
    Position := Position - LargeChange;
  end
  else
  if (Bar2State = 2) and (Position < CoordToPosition(ScreenToClient(Mouse.CursorPos))) then begin
    Position := Position + LargeChange;
  end
  else begin
    if Assigned(Timer) then FreeAndNil(Timer);
  end;
end;

function TsScrollBar.Bar1Rect: TRect;
begin
  FBar1Rect.Left := 0;
  FBar1Rect.Top := 0;
  if Kind = sbHorizontal then begin
    FBar1Rect.Right := PositionToCoord;
    FBar1Rect.Bottom := Height;
  end
  else begin
    FBar1Rect.Right := Width;
    FBar1Rect.Bottom := PositionToCoord;
  end;
  Result := FBar1Rect;
end;

function TsScrollBar.Bar2Rect: TRect;
begin
  if Kind = sbHorizontal then begin
    FBar2Rect.Left := PositionToCoord;
    FBar2Rect.Top := 0;
    FBar2Rect.Right := Width;
    FBar2Rect.Bottom := Height;
  end
  else begin
    FBar2Rect.Left := 0;
    FBar2Rect.Top := PositionToCoord;
    FBar2Rect.Right := Width;
    FBar2Rect.Bottom := Height;
  end;
  Result := FBar2Rect;
end;

procedure TsScrollBar.CMMouseEnter(var Msg: TMessage);
//var
//  p : TPoint;
//  r : TRect;
begin
  if Skinable then begin
    Bar1State := 1;
    Bar2State := 1;

{
    if Assigned(LinkedControl) then begin
      SendMessage(TWinControl(LinkedControl).Handle, CM_MOUSEENTER, 0, 0);
      LinkedControl.Repaint;
      Application.ProcessMessages;
    end;
}
  {
    if Assigned(ParentSStyle) then begin
      p := ParentSStyle.FOwner.ClientToScreen(Point(ParentSStyle.FOwner.Left, ParentSStyle.FOwner.Top));
      r := Rect(p.x, p.y, p.x + ParentSStyle.FOwner.Width, p.y + ParentSStyle.FOwner.Height);
      p := Mouse.CursorPos;
      if PtInRect(r, p) and not ParentSStyle.FMouseAbove then begin
        ParentSStyle.FMouseAbove := True;
        ParentSStyle.Invalidate;
      end;
    end;
  }
    UpdateBar;
  end else inherited;
end;

function TsScrollBar.Btn1DRect: TRect;
var
  i : integer;
begin
  Result := Btn1Rect;
  if Kind = sbHorizontal then begin
    i := GetMaskIndex(Btn1SkinIndex, ArrowLeft, BordersMask);
    if (i > -1) and gd[FBtn1SkinIndex].ReservedBoolean then begin
      Result.Right := math.max(GetSystemMetrics(SM_CXHSCROLL), ma[i].Bmp.Width div 3);
    end;
  end
  else begin
    i := GetMaskIndex(Btn1SkinIndex, ArrowTop, BordersMask);
    if (i > -1) and gd[FBtn1SkinIndex].ReservedBoolean then begin
      Result.Bottom := math.max(GetSystemMetrics(SM_CYVSCROLL), ma[i].Bmp.Height div 2);
    end;
  end;
end;

procedure TsScrollBar.UpdateBar;
begin
  DrawingForbidden := False;
  if RepaintNeeded then Paint;
end;

procedure TsScrollBar.SetInteger(Index, Value: integer);
begin
  case Index of
    0 : begin
      if FBtn1State <> Value then begin
        RepaintNeeded := True;
        FBtn1State := Value;
        case Value of
          1, 2 : begin
            FBtn2State := 0;
            FSliderState := 0;
            FBar1State := 1;
            FBar2State := 1;
          end;
        end;
      end;
    end;
    1 : begin
      if FBtn2State <> Value then begin
        RepaintNeeded := True;
        FBtn2State := Value;
        case Value of
          1, 2 : begin
            FBtn1State := 0;
            FSliderState := 0;
            FBar1State := 1;
            FBar2State := 1;
          end;
        end;
      end;
    end;
    2 : begin
      if FBar1State <> Value then begin
        RepaintNeeded := True;
        FBar1State := Value;
        case Value of
          1, 2 : begin
            FBtn1State := 0;
            FBtn2State := 0;
            FSliderState := 0;
            FBar2State := 1;
          end;
        end;
      end;
    end;
    3 : begin
      if FBar2State <> Value then begin
        RepaintNeeded := True;
        FBar2State := Value;
        case Value of
          1, 2 : begin
            FBtn1State := 0;
            FBtn2State := 0;
            FSliderState := 0;
            FBar1State := 1;
          end;
        end;
      end;
    end;
    4 : begin
      if FSliderState <> Value then begin
        RepaintNeeded := True;
        FSliderState := Value;
        case Value of
          1, 2 : begin
            FBtn1State := 0;
            FBtn2State := 0;
            FBar1State := 1;
            FBar2State := 1;
          end;
        end;
      end;
    end;
  end;
end;

function TsScrollBar.Btn2DRect: TRect;
var
  i : integer;
begin
  Result := Btn2Rect;
  if Kind = sbHorizontal then begin
    i := GetMaskIndex(Btn2SkinIndex, ArrowRight, BordersMask);
    if (i > -1) and gd[FBtn2SkinIndex].ReservedBoolean then begin
      Result.Left := width - math.max(GetSystemMetrics(SM_CXHSCROLL), ma[i].Bmp.Width div 3);
    end;
  end
  else begin
    i := GetMaskIndex(Btn2SkinIndex, ArrowBottom, BordersMask);
    if (i > -1) and gd[FBtn2SkinIndex].ReservedBoolean then begin
      Result.Top := height - math.max(GetSystemMetrics(SM_CYVSCROLL), ma[i].Bmp.Height div 2);
    end;
  end;
end;

function TsScrollBar.BarIsHot: boolean;
begin
  Result := FCommonData.ControlIsActive;
//  if Assigned(ParentSStyle) then Result := Result or ParentSStyle.ControlIsActive;
end;

function TsScrollBar.WorkSize: integer;
begin
  if Kind = sbHorizontal then begin
    Result := Width - 2 * GetSystemMetrics(SM_CXHSCROLL);
  end
  else begin
    Result := Height - 2 * GetSystemMetrics(SM_CYVSCROLL);
  end;
end;

procedure TsScrollBar.ClearDontChange;
begin
  if Smooth then Exit;
  DontChange := False;
  Change(LastPosition);
  LastPosition := 0;
end;

procedure TsScrollBar.InitDontChange;
begin
  if Smooth then Exit;
  DontChange := True;
  LastPosition := LastPosition + Position;
end;

function TsScrollBar.CanFocus: Boolean;
begin
  Result := inherited CanFocus and TabStop;
end;

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

end.