?? sscrollbar.pas
字號:
end;
end;
procedure TsScrollBar.DrawBtnRight(b: TBitmap);
begin
Ci.Bmp := b;
PaintItem(Btn2SkinIndex, ArrowRight, Ci, True,
Btn2State,
Btn2DRect,
Point(Btn2Rect.Left, Btn2Rect.Top), b);
Ci.Bmp := FCommonData.FCacheBmp;
i1 := GetMaskIndex(FBtn2SkinIndex, ArrowRight, ItemGlyph);
if IsValidImgIndex(i1) and (ma[i1].Bmp.Width div 3 < WidthOf(FBtn1Rect)) then begin
p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - ma[i1].Bmp.Width div 3) div 2;// + integer(Btn2State = 2);
p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - ma[i1].Bmp.Height div 2) div 2;// + integer(Btn2State = 2);
if (p.x < 0) or (p.y < 0) then Exit;
PaintRasterGlyph(b, ma[i1].Bmp,
p, Btn2State, ma[i1].TransparentColor);
end;
end;
procedure TsScrollBar.DrawBtnTop(b: TBitmap);
begin
Ci.Bmp := b;
PaintItem(Btn1SkinIndex, ArrowTop, Ci, True,
Btn1State,
Btn1DRect,
Point(Btn1Rect.Left, Btn1Rect.Top), b);
Ci.Bmp := FCommonData.FCacheBmp;
i1 := GetMaskIndex(FBtn1SkinIndex, Arrowtop, ItemGlyph);
if IsValidImgIndex(i1) and (ma[i1].Bmp.Height div 2 < HeightOf(FBtn1Rect)) then begin
p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - ma[i1].Bmp.Width div 3) div 2;// + integer(Btn1State = 2);
p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - ma[i1].Bmp.Height div 2) div 2;// + integer(Btn1State = 2);
if (p.x < 0) or (p.y < 0) then Exit;
PaintRasterGlyph(b, ma[i1].Bmp,
p, Btn1State, ma[i1].TransparentColor);
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;
begin
inherited;
FCommonData.Loaded;
end;
procedure TsScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i : integer;
begin
if not ControlIsReady(Self) then Exit;
if not Skinable or not Enabled or not (Button = mbLeft) then begin inherited; end
else begin
MouseOffset := 0;
{
if Assigned(ParentSStyle) and (ParentSStyle.FOwner is TWinControl) then begin
if not TWinControl(ParentSStyle.FOwner).Focused then TWinControl(ParentSStyle.FOwner).SetFocus;
end
else
}
if CanFocus then SetFocus;
// If Button1 pressed...
if PtInRect(Btn1Rect, Point(x,y)) then begin
if Btn1State <> 2 then begin
Btn1State := 2;
if Position <> Min then begin
DrawingForbidden := True;
Position := FPosition - SmallChange;
PrepareBtnTimer;
end;
end;
end
// If Button2 pressed...
else if PtInRect(Btn2Rect, Point(x,y)) then begin
if Btn2State <> 2 then begin
Btn2State := 2;
if Position <> Max then begin
DrawingForbidden := True;
Position := FPosition + SmallChange;
PrepareBtnTimer;
end;
end;
end
// If slider pressed...
else if PtInRect(SliderRect, Point(x,y)) then begin
InitDontChange;
if SliderState <> 2 then begin
i := CoordToPosition(Point(x, y));
MouseOffset := i - Position;
SliderState := 2;
PrepareTimer;
end;
end
else begin
if PtInRect(Bar1Rect, Point(x,y)) then begin
if Bar1State <> 2 then begin
Bar1State := 2;
Bar2State := integer(BarIsHot);
DrawingForbidden := True;
Position := FPosition - LargeChange;
PrepareBarTimer;
end;
end
else begin
if Bar2State <> 2 then begin
Bar1State := integer(BarIsHot);
Bar2State := 2;
DrawingForbidden := True;
Position := FPosition + LargeChange;
PrepareBarTimer;
end;
end;
end;
UpdateBar;
end;
end;
procedure TsScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not ControlIsReady(Self) then Exit;
if not skinable or not Enabled then begin inherited; end
else begin
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
Bar1State := integer(BarIsHot);
Bar2State := Bar1State;
if SliderState = 2 then begin
DrawingForbidden := True;
Position := CoordToPosition(Point(X, Y)) - MouseOffset;
if PtInRect(SliderRect, Point(X, Y)) then begin
SliderState := 1;
end
else begin
SliderState := 0;
end;
ClearDontChange;
{
if PtInRect(SliderRect, Point(X, Y)) then begin
SliderState := 1;
end
else begin
SliderState := 0;
end;
}
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;
end;
end;
function TsScrollBar.NotRightToLeft: Boolean;
begin
Result := (not IsRightToLeft) or (FKind = 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;
if (SliderState = 2) then begin
Position := CoordToPosition(ScreenToClient(Mouse.CursorPos)) - MouseOffset;
end;
SetCapture(Handle);
end;
procedure TsScrollBar.Paint;
var
DC, SavedDC : hdc;
b : TBitmap;
lCI : TCacheInfo;
LocalState : integer;
c : TsColor;
SkinIndex : integer;
begin
SkinIndex := -1;
if DrawingForbidden or not ControlIsReady(Self) or (csCreating in Controlstate) then Exit;
RepaintNeeded := False;
b := TBitmap.Create;
b.Width := Width;
b.Height := Height;
b.PixelFormat := pf24bit;
try
if FCommonData.FCacheBmp.Width <> Width then FCommonData.FCacheBmp.Width := Width;
if FCommonData.FCacheBmp.Height <> Height then FCommonData.FCacheBmp.Height := Height;
{ 28.11.2003 Serge
if ParentSStyle <> nil then begin
lCI.Bmp := ParentSStyle.FCacheBmp;
lCI.Ready := False;
lCI.X := 0;
lCI.Y := 0;
end
}
if LinkedControl <> nil then begin
GlobalCacheInfo.Ready := False;
if LinkedControl is TWinControl then begin
SendMessage(TWinControl(LinkedControl).Handle, SM_GETCACHE, 0, 0);
end
else begin
LinkedControl.Perform(SM_GETCACHE, 0, 0);
end;
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;
if (HeightOf(Bar1Rect) > 0) and (WidthOf(Bar1Rect) > 0) then begin
LocalState := Bar1State;
if LocalState = 0 then LocalState := integer(BarIsHot);
LocalState := LocalState * integer(Enabled);
if Kind = sbHorizontal then begin
SkinIndex := GetSkinIndex(ScrollBar1 + 'H');
PaintItem(SkinIndex, ScrollBar1 + 'H', lCi, True, LocalState, Bar1Rect, Point(Left, Top), FCommonData.FCacheBmp);
end
else begin
SkinIndex := GetSkinIndex(ScrollBar1 + 'V');
PaintItem(SkinIndex, ScrollBar1 + 'V', lCi, True, LocalState, Bar1Rect, Point(Left, Top), FCommonData.FCacheBmp);
end;
end;
if (HeightOf(Bar2Rect) > 0) and (WidthOf(Bar2Rect) > 0) then begin
LocalState := Bar2State;
if LocalState = 0 then LocalState := integer(BarIsHot);
LocalState := LocalState * integer(Enabled);
Bar2Rect;
if Kind = sbHorizontal then begin
PaintItem(GetSkinIndex(ScrollBar2 + 'H'), ScrollBar2 + 'H', lCi, True, LocalState, Bar2Rect, Point(Left + Bar2Rect.Left, Top + Bar2Rect.Top), FCommonData.FCacheBmp);
end
else begin
PaintItem(GetSkinIndex(ScrollBar2 + 'V'), ScrollBar2 + 'V', lCi, True, LocalState, Bar2Rect, Point(Left + Bar2Rect.Left, Top + Bar2Rect.Top), FCommonData.FCacheBmp);
end;
end;
BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
if Kind = sbHorizontal then begin
DrawBtnLeft(b);
DrawBtnRight(b);
end else begin
DrawBtnTop(b);
DrawBtnBottom(b);
end;
if (LinkedControl = nil) or Enabled or not LinkedControl.Enabled then begin
DrawSlider(b)
end;
except
end;
DC := GetWindowDC(Handle);
SavedDC := SaveDC(DC);
try
if not Enabled then begin
lCI := GetParentCache(FCommonData);
if (LinkedControl <> nil) and (LinkedControl <> Parent)
then begin
c.C := ColorToRGB(gd[SkinIndex].PaintingColor);
FadeBmp(b, Rect(0, 0, b.Width + 1, b.Height + 1), 60, c, 0, 0);
end
else BmpDisabledKind(b, FDisabledKind, Parent, lCI, Point(Left, Top));
end;
BitBlt(DC, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
finally
RestoreDC(DC, SavedDC);
ReleaseDC(Handle, DC);
if Assigned(b) then FreeAndNil(b);
end;
end;
procedure TsScrollBar.Preparetimer;
begin
if Assigned(Timer) then FreeAndNil(Timer);
Timer := TTimer.Create(Self);
Timer.OnTimer := OnTimer;
Timer.Interval := 100;
Timer.Enabled := True;
SetCapture(Handle);
end;
procedure TsScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;
function TsScrollBar.ScrollSliderIndex: integer;
begin
FScrollSliderIndex := GetSkinIndex(SliderSectionName);
Result := FScrollSliderIndex;
end;
procedure TsScrollBar.SetKind(Value: TScrollBarKind);
begin
if FKind <> Value then begin
FKind := Value;
if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
RecreateWnd;
end;
end;
procedure TsScrollBar.SetMax(Value: Integer);
begin
SetParams(FPosition, FMin, Value);
Invalidate;
end;
procedure TsScrollBar.SetMin(Value: Integer);
begin
SetParams(FPosition, Value, FMax);
Invalidate;
end;
procedure TsScrollBar.SetPageSize(Value: Integer);
var
ScrollInfo: TScrollInfo;
begin
// if (FPageSize = Value) or (FPageSize > FMax) or (Value > FMax) then exit;
if (Value < 0) then exit;
FPageSize := Value;
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.nPage := Value;
ScrollInfo.fMask := SIF_PAGE;
if HandleAllocated then
SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
Invalidate;
end;
procedure TsScrollBar.SetParams(APosition, AMin, AMax: Integer);
var
OldValue : integer;
begin
OldValue := FPosition;
if (AMax <= AMin) then begin
ShowError(SScrollBarRange + #10#13 + 'Max = ' + IntToStr(AMAx))
end;
if APosition < AMin then APosition := AMin;
if APosition > AMax then APosition := AMax;
if (FMin <> AMin) or (FMax <> AMax) then begin
FMin := AMin;
FMax := AMax;
if HandleAllocated then SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
end;
if FPosition <> APosition then begin
FPosition := APosition;
if HandleAllocated then begin
if NotRightToLeft then begin
SetScrollPos(Handle, SB_CTL, FPosition, True)
end
else begin
SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
end;
end;
// Enabled := True;?
if Skinable then begin
RepaintNeeded := True;
Change(OldValue);
end;
end;
end;
procedure TsScrollBar.SetPosition(Value: Integer);
begin
if (csCreating in ControlState) or (csDestroying in ComponentState) then Exit;
if (Value = FPosition) or
((FPosition = FMin) and (Value < FMin)) or
((FPosition = FMax) and (Value > FMax - 1))
then Exit;
SetParams(Value, FMin, FMax);
UpdateBar;
end;
function TsScrollBar.SliderRect: TRect;
begin
if Kind = sbHorizontal then begin
FSliderRect.Left := PositionToCoord - SliderSize div 2;
FSliderRect.Top := 0;
FSliderRect.Right := FSliderRect.Left + SliderSize;
FSliderRect.Bottom := Height;
end
else begin
FSliderRect.Left := 0;
FSliderRect.Top := PositionToCoord - SliderSize div 2;
FSliderRect.Right := Width;
FSliderRect.Bottom := FSliderRect.Top + SliderSize;
end;
Result := FSliderRect;
end;
function TsScrollBar.SliderSize : integer;
const
MinSize = 14;
begin
if PageSize = 0 then begin
Result := MinSize;
end
else begin
Result := Round(math.max(MinSize, PageSize * (WorkSize / (Max + PageSize - Min))));
end;
end;
procedure TsScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if Skinable then begin
if OnTop then BringToFront;
Message.Result := 1;
end
else inherited;
end;
procedure TsScrollBar.WndProc(var Message: TMessage);
begin
if Assigned(FCommonData) then FCommonData.WndProc(Message);
inherited WndProc(Message);
case Message.Msg of
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -