?? sscrollbar.pas
字號:
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.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -