📄 sscrollbar.pas
字号:
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 + -