sscrollbar.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

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

function TsScrollBar.PositionToCoord: integer;
begin
  if Enabled then begin
    if (FSI.nMax - FSI.nMin - Math.Max(Integer(FSI.nPage) -1,0)) <> 0 then
      if Kind = sbHorizontal then begin
        Result := FirstPoint + SliderSize div 2 + Round((FCurrPos - FSI.nMin) * ((Width - 2 * FirstPoint - SliderSize) / (FSI.nMax - FSI.nMin - Math.Max(Integer(FSI.nPage) -1,0))));
      end
      else begin
        Result := FirstPoint + SliderSize div 2 + Round((FCurrPos - FSI.nMin) * ((Height - 2 * FirstPoint - SliderSize) / (FSI.nMax - FSI.nMin - Math.Max(Integer(FSI.nPage) -1,0))));
      end
    else begin
      Result := 0;
    end;
  end
  else begin
    if Kind = sbHorizontal then Result := Width div 2 else Result := Height div 2;
  end;
end;

procedure TsScrollBar.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited;
end;

procedure TsScrollBar.WMPaint(var Msg: TWMPaint);
begin
  if DrawingForbidden or (not (csCreating in Controlstate) and Assigned(SkinData.SkinManager) and SkinData.SkinManager.SkinData.Active and not (csDestroying in Componentstate)) then begin
    try
      Self.FCommonData.Updating := Self.FCommonData.Updating;
      Paint(Msg.DC);
    except
    end
  end
  else inherited;
end;

procedure TsScrollBar.CMMouseLeave(var Msg: TMessage);
begin
  if Skinned(Self) then begin
    Btn1State := 0;
    Btn2State := 0;
    if SliderState <> 2 then begin
      SliderState := 0;
      Bar1State := 0;
      Bar2State := 0;
    end;
    UpdateBar;
  end
  else inherited;
end;

procedure TsScrollBar.PrepareBarTimer;
begin
  if Assigned(Timer) then FreeAndNil(Timer);
  Timer := TTimer.Create(Self);
  Timer.OnTimer := OnBarTimer;
  Timer.Interval := 500;// 100;                KJS
  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 (FCurrPos > CoordToPosition(ScreenToClient(Mouse.CursorPos))) then begin
    IncPos(-Math.Max(Integer(FSI.nPage),1));
  end
  else
  if (Bar2State = 2) and (FCurrPos < CoordToPosition(ScreenToClient(Mouse.CursorPos))) then begin
    IncPos(Math.Max(Integer(FSI.nPage),1));
  end
  else begin
    if Assigned(Timer) then FreeAndNil(Timer);
  end;
  if assigned(Timer) and (Timer.Interval > 50) then Timer.Interval := 50;        //KJS
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);
begin
  if Skinned(Self) then begin
    Bar1State := 1;
    Bar2State := 1;
    UpdateBar;
  end
  else inherited;
end;

function TsScrollBar.Btn1DRect: TRect;
begin
  Result := Btn1Rect;
  with FCommonData.SkinManager.ConstData, FCommonData.SkinManager do begin
    if Kind = sbHorizontal then begin
      if (IndexScrollLeft > -1) and gd[IndexScrollLeft].ReservedBoolean and (MaskScrollLeft > -1) then begin
        if ma[MaskScrollLeft].Bmp = nil
          then Result.Right := math.max(GetSystemMetrics(SM_CXHSCROLL), WidthOf(ma[MaskScrollLeft].R) div ma[MaskScrollLeft].ImageCount)
          else Result.Right := math.max(GetSystemMetrics(SM_CXHSCROLL), ma[MaskScrollLeft].Bmp.Width div 3);
      end;
    end
    else begin
      if (IndexScrollTop > -1) and gd[ConstData.IndexScrollTop].ReservedBoolean and (MaskScrollTop > -1) then begin
        if ma[ConstData.MaskScrollTop].Bmp = nil
          then Result.Bottom := math.max(GetSystemMetrics(SM_CYVSCROLL), HeightOf(ma[MaskScrollTop].R) div (1 + ma[MaskScrollTop].MaskType))
          else Result.Bottom := math.max(GetSystemMetrics(SM_CYVSCROLL), ma[MaskScrollTop].Bmp.Height div 2);
      end;
    end;
  end;
end;

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

procedure TsScrollBar.SetInteger(Index, Value: integer);
begin
  case Index of
    0 : 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;
    1 : 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;
    2 : 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;
    3 : 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;
    4 : 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;

function TsScrollBar.Btn2DRect: TRect;
begin
  Result := Btn2Rect;
  with FCommonData.SkinManager.ConstData, FCommonData.SkinManager do begin
    if Kind = sbHorizontal then begin
      if (IndexScrollRight > -1) and gd[IndexScrollRight].ReservedBoolean and (MaskScrollRight > -1) then begin
        if ma[MaskScrollRight].Bmp = nil
          then Result.Left := width - math.max(GetSystemMetrics(SM_CXHSCROLL), WidthOf(ma[MaskScrollRight].R) div ma[MaskScrollRight].ImageCount)
          else Result.Left := width - math.max(GetSystemMetrics(SM_CXHSCROLL), ma[MaskScrollRight].Bmp.Width div 3);
      end;
    end
    else begin
      if (IndexScrollBottom > -1) and gd[IndexScrollBottom].ReservedBoolean and (MaskScrollBottom > -1) then begin
        if ma[MaskScrollBottom].Bmp = nil
          then Result.Top := height - math.max(GetSystemMetrics(SM_CYVSCROLL), HeightOf(ma[MaskScrollBottom].R) div (1 + ma[MaskScrollBottom].MaskType))
          else Result.Top := height - math.max(GetSystemMetrics(SM_CYVSCROLL), ma[MaskScrollBottom].Bmp.Height div 2);
      end;
    end;
  end;
end;

function TsScrollBar.BarIsHot: boolean;
begin
  Result := ControlIsActive(FCommonData);
end;

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

procedure TsScrollBar.ClearDontChange;
begin
  DontChange := False;
end;

procedure TsScrollBar.InitDontChange;
begin
  DontChange := True;
end;

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

procedure TsScrollBar.PlaceToLinked;
begin
//  if {Visible and} (LinkedControl <> nil) and (Parent <> nil) and not (csFreeNotification in Parent.ComponentState) and not DrawingForbidden then PlaceCtlAboveOther(Self, LinkedControl);
end;

procedure TsScrollBar.IncPos(Offset: integer);
begin
  SetPos(FCurrPos+ Offset);
end;

procedure TsScrollBar.SetPos(Pos: integer);
const
  Kinds: array[TScrollBarKind] of DWORD = (SB_HORZ, SB_VERT);
  Styles: array[TScrollBarKind] of DWORD = (WM_HSCROLL, WM_VSCROLL);
var
  m : TWMScroll;

begin
  FCurrPos := Pos;

  if FCurrPos < FSI.nMin then
    FCurrPos := FSI.nMin
  else if FCurrPos > (FSI.nMax - Math.Max(Integer(FSI.nPage) - 1, 0)) then
    FCurrPos := (FSI.nMax - Math.Max(Integer(FSI.nPage) - 1, 0));

  m.Msg := Styles[Kind];
  m.ScrollBar := Handle;
  m.ScrollCode := SmallInt(ScrollCode);

  if (m.ScrollCode = SB_THUMBTRACK) then begin
    if (FSI.nTrackPos = FCurrPos) and (not FBeginTrack) then exit;
    FBeginTrack := false;
    FSI.nTrackPos := FCurrPos
  end else
    FSI.nPos := FCurrPos;

  if m.ScrollCode in [SB_THUMBTRACK,SB_THUMBPOSITION] then
    m.Pos := FCurrPos
  else
    m.Pos := 0;

  SendMessage(Handle, M.Msg, TMessage(M).WParam, TMessage(M).LParam);

  RepaintNeeded := true;
  UpdateBar;

  if DoSendChanges and Assigned(LinkedControl) and LinkedControl.HandleAllocated then begin
    SendMessage(LinkedControl.Handle, M.Msg, TMessage(M).WParam, TMessage(M).LParam);
  end;
end;

procedure TsScrollBar.CNHScroll(var Message: TWMHScroll);
begin
  if not (DoSendChanges and Assigned(LinkedControl)) then inherited;
end;

procedure TsScrollBar.CNVScroll(var Message: TWMVScroll);
begin
  if not (DoSendChanges and Assigned(LinkedControl)) then inherited;
end;

function TsScrollBar.GetSkinManager: TsSkinManager;
begin
  Result := SkinData.SkinManager
end;

procedure TsScrollBar.SetSkinManager(const Value: TsSkinManager);
begin
  SkinData.SkinManager := Value;
end;

end.