⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sscrollbar.pas

📁 Alpha Controls.v5.46b Source
💻 PAS
📖 第 1 页 / 共 4 页
字号:
      Y := FTop;
      Width := FWidth;
      Height := FHeight;
      if Parent <> nil then WndParent := Parent.Handle else WndParent := ParentWindow;
      WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
      WindowClass.lpfnWndProc := @DefWindowProc;
      WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
      WindowClass.hbrBackground := 0;
      WindowClass.hInstance := HInstance;
      StrPCopy(WinClassName, ClassName);
    end;
  end;
begin
  if SkinnedRecreate then begin
    DefCreateParams(Params);
    if NotRightToLeft then TScrollBar_(Self).FRTLFactor := 1 else TScrollBar_(Self).FRTLFactor := -1;
  end
  else begin
    inherited CreateParams(Params);
    if Skinned(Self) then MustBerecreated := True;
  end;
end;

destructor TsScrollBar.Destroy;
begin
  if Assigned(Timer) then begin
    Timer.Enabled := False;
    FreeAndNil(Timer);
  end;
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

procedure TsScrollBar.DrawBtnBottom(b: TBitmap);
begin
  with FCommonData.SkinManager.ConstData do begin
    Ci.Bmp := b;
    PaintItemFast(IndexScrollBottom, MaskScrollBottom, IndexBGScrollBottom, IndexBGHotScrollBottom, s_ScrollBtnBottom, Ci, True,
      Btn2State,
      Btn2DRect,
      Point(0, 0), b, SkinData.SkinManager);
    Ci.Bmp := FCommonData.FCacheBmp;

    if FCommonData.SkinManager.IsValidImgIndex(MaskArrowBottom) then
      with FCommonData.SkinManager do begin
      if ma[MaskArrowBottom].Bmp = nil then begin
        p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - WidthOf(ma[MaskArrowBottom].R) div ma[MaskArrowBottom].ImageCount) div 2;// + integer(Btn2State = 2);
        p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - HeightOf(ma[MaskArrowBottom].R) div (1 + ma[MaskArrowBottom].MaskType)) div 2;// + integer(Btn2State = 2);
      end
      else if (ma[MaskArrowBottom].Bmp.Height div 2 < HeightOf(FBtn2Rect)) then begin
        p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - ma[MaskArrowBottom].Bmp.Width div 3) div 2;// + integer(Btn2State = 2);
        p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - ma[MaskArrowBottom].Bmp.Height div 2) div 2;// + integer(Btn2State = 2);
      end;
      if (p.x < 0) or (p.y < 0) then Exit;
      DrawSkinGlyph(b, p, Btn2State, 1, ma[MaskArrowBottom]);
    end;
  end;
end;

procedure TsScrollBar.DrawBtnLeft(b: TBitmap);
begin
  with FCommonData.SkinManager.ConstData do begin
    Ci.Bmp := b;
    PaintItemFast(IndexScrollLeft, MaskScrollLeft, IndexBGScrollLeft, IndexBGHotScrollLeft, s_ScrollBtnLeft, Ci, True,
      Btn1State,
      Btn1DRect,
      Point(0, 0), b, SkinData.SkinManager);
    Ci.Bmp := FCommonData.FCacheBmp;

    if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidImgIndex(MaskArrowLeft) then
      with FCommonData.SkinManager do begin
      if ma[MaskArrowLeft].Bmp = nil then begin
        p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - WidthOf(ma[MaskArrowLeft].R) div ma[MaskArrowLeft].ImageCount) div 2;// + integer(Btn1State = 2);
        p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - HeightOf(ma[MaskArrowLeft].R) div (1 + ma[MaskArrowLeft].MaskType)) div 2;// + integer(Btn1State = 2);
      end
      else if (ma[MaskArrowLeft].Bmp.Width div 3 < WidthOf(FBtn1Rect)) then begin
        p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - ma[MaskArrowLeft].Bmp.Width div 3) div 2;// + integer(Btn1State = 2);
        p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - ma[MaskArrowLeft].Bmp.Height div 2) div 2;// + integer(Btn1State = 2);
      end;
      if (p.x < 0) or (p.y < 0) then Exit;
      DrawSkinGlyph(b, p, Btn1State, 1, ma[MaskArrowLeft]);
    end;
  end;
end;

procedure TsScrollBar.DrawBtnRight(b: TBitmap);
begin
  with FCommonData.SkinManager.ConstData do begin
    Ci.Bmp := b;
    PaintItemFast(IndexScrollRight, MaskScrollRight, IndexBGScrollRight, IndexBGHotScrollRight, s_ScrollBtnRight, Ci, True,
      Btn2State,
      Btn2DRect,
      Point(0, 0), b, SkinData.SkinManager);
    Ci.Bmp := FCommonData.FCacheBmp;

    if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidImgIndex(MaskArrowRight) then
      with FCommonData.SkinManager do begin
      if ma[MaskArrowRight].Bmp = nil then begin
        p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - WidthOf(ma[MaskArrowRight].R) div ma[MaskArrowRight].ImageCount) div 2;// + integer(Btn2State = 2);
        p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - HeightOf(ma[MaskArrowRight].R) div (1 + ma[MaskArrowRight].MaskType)) div 2;// + integer(Btn2State = 2);
      end
      else if (ma[MaskArrowRight].Bmp.Width div 3 < WidthOf(FBtn1Rect)) then begin
        p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - ma[MaskArrowRight].Bmp.Width div 3) div 2;// + integer(Btn2State = 2);
        p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - ma[MaskArrowRight].Bmp.Height div 2) div 2;// + integer(Btn2State = 2);
      end;
      if (p.x < 0) or (p.y < 0) then Exit;
      DrawSkinGlyph(b, p, Btn2State, 1, ma[MaskArrowRight]);
    end;
  end;
end;

procedure TsScrollBar.DrawBtnTop(b: TBitmap);
begin
  with FCommonData.SkinManager.ConstData do begin
    Ci.Bmp := b;

    PaintItemFast(IndexScrollTop, MaskScrollTop, IndexBGScrollTop, IndexBGHotScrollTop, s_ScrollBtnTop, Ci, True,
      Btn1State,
      Btn1DRect,
      Point(0, 0), b, SkinData.SkinManager);
    Ci.Bmp := FCommonData.FCacheBmp;

    if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidImgIndex(MaskArrowTop) then
      with FCommonData.SkinManager do begin
      if ma[MaskArrowTop].Bmp = nil then begin
        p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - WidthOf(ma[MaskArrowTop].R) div ma[MaskArrowTop].ImageCount) div 2;// + integer(Btn1State = 2);
        p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - HeightOf(ma[MaskArrowTop].R) div (1 + ma[MaskArrowTop].MaskType)) div 2;// + integer(Btn1State = 2);
      end
      else if (ma[MaskArrowTop].Bmp.Height div 2 < HeightOf(FBtn1Rect)) then begin
        p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - ma[MaskArrowTop].Bmp.Width div 3) div 2;
        p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - ma[MaskArrowTop].Bmp.Height div 2) div 2;
      end;
      if (p.x < 0) or (p.y < 0) then Exit;
      DrawSkinGlyph(b, p, Btn1State, 1, ma[MaskArrowTop]);
    end;
  end;
end;

function TsScrollBar.FirstPoint: integer;
begin
  if Kind = sbHorizontal then begin
    Result := GetSystemMetrics(SM_CXHSCROLL);
  end
  else begin
    Result := GetSystemMetrics(SM_CYVSCROLL);
  end;
end;

procedure TsScrollBar.Loaded;
var
  OldPos : integer;
begin
  inherited;
  FCommonData.Loaded;
{$IFDEF CHECKXP}
  if UseThemes and not (SkinData.Skinned and SkinData.SkinManager.SkinData.Active) then begin
    ControlStyle := ControlStyle - [csParentBackground]; // Patching of bug with TGraphicControls repainting when XPThemes used
  end;
{$ENDIF}
  if MustBeRecreated then begin // Control must be recreated for the skinned mode using without std blinking
    MustBeRecreated := False;
    SkinnedRecreate := True;
    OldPos := Position;
    RecreateWnd;
    Position := OldPos;
    SkinnedRecreate := False;
  end;
end;

procedure TsScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin
  if not Skinned(Self) or not Enabled or not (Button = mbLeft) then inherited else begin
    if not ControlIsReady(Self) then Exit;
    AppShowHint := Application.ShowHint;
    Application.ShowHint := False;
    MouseOffset := 0;
    if CanFocus then SetFocus;
    // If Button1 pressed...
    if PtInRect(Btn1Rect, Point(x,y)) then begin
      if Btn1State <> 2 then begin
        if Kind = sbVertical then ScrollCode := SB_LINEUP else ScrollCode := SB_LINELEFT;
        Btn1State := 2;
        DrawingForbidden := True;
        IncPos(-1);
        PrepareBtnTimer;
      end;
    end
    // If Button2 pressed...
    else if PtInRect(Btn2Rect, Point(x,y)) then begin
      if Btn2State <> 2 then begin
        Btn2State := 2;
        if Kind = sbVertical then ScrollCode := SB_LINEDOWN else ScrollCode := SB_LINERIGHT;
        DrawingForbidden := True;
        IncPos(1);
        PrepareBtnTimer;
      end;
    end
    // If slider pressed...
    else if PtInRect(SliderRect, Point(x,y)) then begin
      ScrollCode := SB_THUMBTRACK;// v403 SB_THUMBPOSITION;
      InitDontChange;
      if SliderState <> 2 then begin
        i := CoordToPosition(Point(x, y));
        MouseOffset := i - FCurrPos;
        SliderState := 2;
        FBeginTrack := true;
        IncPos(0);
        PrepareTimer;
      end;
    end
    else begin
      if PtInRect(Bar1Rect, Point(x,y)) then begin
        if Kind = sbVertical then ScrollCode := SB_PAGEUP else ScrollCode := SB_PAGELEFT;
        if Bar1State <> 2 then begin
          Bar1State := 2;
          Bar2State := integer(BarIsHot);
          DrawingForbidden := True;
          IncPos(-Math.Max(Integer(FSI.nPage),1));
          PrepareBarTimer;
        end;
      end
      else begin
        if Kind = sbVertical then ScrollCode := SB_PAGEDOWN else ScrollCode := SB_PAGERIGHT;
        if Bar2State <> 2 then begin
          Bar1State := integer(BarIsHot);
          Bar2State := 2;
          DrawingForbidden := True;
          IncPos(Math.Max(Integer(FSI.nPage),1));
          PrepareBarTimer;
        end;
      end;
    end;
    UpdateBar;
    inherited;
  end;
end;

procedure TsScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not Skinned(Self) or not Enabled then inherited else begin
    if not ControlIsReady(Self) then Exit;
    if Assigned(Timer) then begin
      Timer.Enabled := False;
      if Assigned(Timer) then FreeAndNil(Timer);
    end;
    if PtInRect(SliderRect, Point(X, Y)) or (SliderState = 2) then begin
      ScrollCode := SB_THUMBPOSITION;
      Bar1State := integer(BarIsHot);
      Bar2State := Bar1State;
      if SliderState = 2 then begin
        DrawingForbidden := True;
        IncPos(0);
        if PtInRect(SliderRect, Point(X, Y)) then begin
          SliderState := 1;
        end
        else begin
          SliderState := 0;
        end;
        ClearDontChange;
      end
      else
    end
    else
    if PtInRect(Btn1Rect, Point(X, Y)) and (Btn1State = 2) then begin
      Btn1State := 1;
    end
    else if PtInRect(Btn2Rect, Point(X, Y)) and (Btn2State = 2) then begin
      Btn2State := 1;
    end
    else
    if (Bar1State = 2) then begin
      Bar1State := integer(BarIsHot);
    end
    else
    if (Bar2State = 2) then begin
      Bar2State := integer(BarIsHot);
    end;
    UpdateBar;
    ReleaseCapture;
    inherited;
    ScrollCode := SB_ENDSCROLL;
    IncPos(0);
    Application.ShowHint := AppShowHint;
  end;
end;

function TsScrollBar.NotRightToLeft: Boolean;
begin
  Result := not IsRightToLeft or (Kind = sbVertical);
end;

procedure TsScrollBar.OnTimer(Sender: TObject);
begin
  if not Assigned(Timer) or not ControlIsReady(Self) or (csDestroying in Timer.ComponentState) or FCommonData.FMouseAbove then Exit;
  SetPos(CoordToPosition(ScreenToClient(Mouse.CursorPos)) - MouseOffset);
  SetCapture(Handle);
end;

procedure TsScrollBar.Paint(MsgDC : hdc);
var
  DC, SavedDC : hdc;
  bmp : TBitmap;
  lCI : TCacheInfo;
  LocalState : integer;
  c : TsColor;
  PS : TPaintStruct;
begin
  bmp := nil;
  BeginPaint(Handle, PS);
  if MsgDC = 0 then DC := GetWindowDC(Handle) else DC := MsgDC;
  SavedDC := SaveDC(DC);
  try
    if DrawingForbidden or not ControlIsReady(Self) or RestrictDrawing or (csDestroying in ComponentState) or (csLoading in ComponentState) or FCommonData.Updating then else begin

      RepaintNeeded := False;
      FCommonData.InitCacheBmp;

      if not Enabled
        then bmp := CreateBmpLike(FCommonData.FCacheBmp)
        else bmp := FCommonData.FCacheBmp;

      if (LinkedControl <> nil) and (LinkedControl is TWinControl) then begin
        GlobalCacheInfo.Ready := False;
        SendAMessage(LinkedControl, AC_GETCACHE);
        lCI := GlobalCacheInfo;
        if not (LinkedControl is TCustomForm) then begin
          dec(lCI.X, LinkedControl.Left);
          dec(lCI.Y, LinkedControl.Top);
        end;
      end
      else begin
        lCI := GetParentCache(FCommonData);
      end;

      with FCommonData.SkinManager.ConstData do begin
        Bar1Rect;
        if (HeightOf(FBar1Rect) > 0) and (WidthOf(FBar1Rect) > 0) then begin
          LocalState := Bar1State;
          if LocalState = 0 then LocalState := integer(BarIsHot);
          LocalState := LocalState * integer(Enabled);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -