?? sscrollbox.pas
字號(hào):
inc(VertOffset, OldValue - VSBar.Position);
SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, VSBar.Position), 0);
if Assigned(VSBar) then begin
VSBar.DrawingForbidden := False;
end else Exit;
Scrolling := False;
CommonData.BgChanged := False;
if not VSBar.DontChange then begin
Repaint;
end;
end;
end;
procedure TsScrollBox.Paint;
begin
if not ControlIsReady(Self) or Scrolling then Exit;
if Assigned(FCommonData) and FCommonData.BGChanged then begin
PrepareCache;
end;
BitBlt(FCanvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
RepaintsControls(Self, True);
PaintControls(Canvas.Handle, nil);
RefreshScrolls;
end;
{
procedure TsScrollBox.PaintWindow(DC: HDC);
var
PS : TPaintStruct;
begin
// Design - time drawing
if IsValidSkinindex(FCommonData.SkinIndex) then begin
FCanvas.Lock;
try
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
Paint;
finally
FCanvas.Handle := 0;
EndPaint(Handle, PS);
end;
finally
FCanvas.Unlock;
end;
end
else begin
inherited PaintWindow(DC);
end;
end;
}
procedure TsScrollBox.PrepareCache;
var
CI : TCacheInfo;
begin
try
FCommonData.InitCacheBmp;
CI.Ready := False;
CI := GetParentCache(FCommonData);
if FCommonData.RegionChanged then begin
FCommonData.FRegion := 0;
FCommonData.FRegion := CreateRectRgn(0,
0,
Width,
Height);
end;
PaintControl(FCommonData.SkinIndex, FCommonData.BorderIndex,
FCommonData.SkinSection, Ci,
False, 0,
Point(Left, Top),
FCommonData.FCacheBmp, FCommonData.FRegion
);
if FCommonData.RegionChanged then begin
SetWindowRgn(Handle, FCommonData.FRegion, True);
FCommonData.RegionChanged := False;
end;
FCommonData.BGChanged := False;
except
Alert('TsScrollBox.PrepareCache error');
end;
end;
procedure TsScrollBox.RefreshScrolls;
var
vsi, hsi : TsScrollInfo;
begin
if csDestroying in ComponentState then Exit;
try
if not ControlIsReady(Self) or not(HandleAllocated) then Exit;
vsi := GetVScrollInfo;
hsi := GetHScrollInfo;
if not sSkinData.Active or not Visible then begin
if Grip <> nil then begin
// ! Exception arises if called in WndProc... Serge
if not (csDesigning in ComponentState) then begin
Grip.Visible := False;
end
else begin
if Assigned(Grip) then FreeAndNil(Grip);
end;
end;
ClearOffset(sbVertical);
ClearOffset(sbHorizontal);
Exit;
end
else begin
if not vsi.Visible then ClearOffset(sbVertical);
if not hsi.Visible then ClearOffset(sbHorizontal);
end;
// Prepare vertical scrollbar
if vsi.Visible then begin
if (VSBar = nil) then begin
VSBar := TsScrollBar.Create(Self);
VSBar.LinkedControl := Self;
VSBar.OnChange := OnVSBChange;
VSBar.DrawingForbidden := True;
VSBar.TabStop := False;
VSBar.Kind := sbVertical;
VSBar.Width := WidthOf(vsi.Rect);
VSBar.Parent := Parent;
VSBar.Smooth := VertScrollBar.Smooth;
BringToFront;
VSBar.Visible := True;
VSBar.BringToFront;
end
else begin
VSBar.Visible := True;
VSBar.BringtoFront;
end;
if Assigned(VSBar) then begin
ControlIsReady(VSBar);
VSBar.DrawingForbidden := True;
VSBar.Max := vsi.Max;
VSBar.SmallChange := VertScrollBar.Increment;
VSBar.Min := 0;
VSBar.PageSize := vsi.Page;
VSBar.LargeChange := 80;
VSBar.DrawingForbidden := False;
VSBar.SetBounds(vsi.Rect.Left, vsi.Rect.Top, WidthOf(vsi.Rect), HeightOf(vsi.Rect));
end;
end else if Assigned(VSBar) then begin
ClearOffset(sbVertical);
end;
// Prepare horizontal scrollbar
if hsi.Visible then begin
if (HSBar = nil) then begin
if not Assigned(VSBar) then BringToFront;
HSBar := TsScrollBar.Create(Self);
HSBar.LinkedControl := Self;
HSBar.OnChange := OnHSBChange;
HSBar.DrawingForbidden := True;
HSBar.Visible := True;
HSBar.TabStop := False;
HSBar.Kind := sbHorizontal;
HSBar.Height := HeightOf(hsi.Rect);
HSBar.Parent := Parent;
HSBar.Smooth := HorzScrollBar.Smooth;
end
else begin
HSBar.Visible := True;
HSBar.BringtoFront;
end;
if Assigned(HSBar) then begin
ControlIsReady(HSBar);
HSBar.DrawingForbidden := True;
HSBar.Max := hsi.Max;
HSBar.SmallChange := HorzScrollBar.Increment;
HSBar.Min := 0;
HSBar.PageSize := hsi.Page;
HSBar.LargeChange := 80;
HSBar.DrawingForbidden := False;
HSBar.SetBounds(hsi.Rect.Left, hsi.Rect.Top, WidthOf(hsi.Rect), HeightOf(hsi.Rect));
end;
end else if Assigned(HSBar) then begin
ClearOffset(sbHorizontal);
end;
if vsi.Visible and hsi.Visible then begin
if Grip = nil then begin
Grip := TsGrip.Create(Self);
Grip.LinkedControl := Self;
Grip.Parent := Parent;
Grip.Name := 'GripFor' + Name;
end
else begin
Grip.Visible := True;
Grip.BringToFront;
end;
if Grip <> nil then begin
Grip.SetBounds(VSBar.Left + 1, HSBar.Top + 1, VSBar.Width - 1, HSBar.Height - 1);
end;
end
else begin
if Grip <> nil then begin
// ! Exception arises if called in WndProc... Serge
if not (csDesigning in ComponentState) then begin
Grip.Visible := False;
end
else begin
if Assigned(Grip) then FreeAndNil(Grip);
end;
end;
end;
except
//alert('Error in TsScrollBox.RefreshScrolls');
end;
end;
procedure TsScrollBox.SetBorderStyle(const Value: TBorderStyle);
begin
if Value <> FBorderStyle then begin
FBorderStyle := Value;
RecreateWnd;
end;
end;
procedure TsScrollBox.WMMouseWheel(var Message: TMessage);
begin
inherited;
RefreshScrolls;
end;
procedure TsScrollBox.WMPaint(var Message: TWMPaint);
var
DC, SavedDC : hdc;
PS : TPaintStruct;
begin
if IsValidSkinindex(FCommonData.SkinIndex) then begin
Message.Result := 1;
if Scrolling then Exit;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
SavedDC := SaveDC(DC);
Canvas.Lock;
Canvas.Handle := DC;
try;
Paint;
Canvas.Handle := 0;
finally
Canvas.Unlock;
RestoreDC(DC, SavedDC);
end;
end else inherited;
end;
procedure TsScrollBox.WndProc(var Message: TMessage);
begin
if not ControlIsReady(Self) then inherited
else begin
if Assigned(FCommonData) and FCommonData.Skinned then begin
case Message.Msg of
CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : if FCommonData.Skinned then begin
FCommonData.BGChanged := True;
Repaint;
if not Scrolling then RefreshScrolls;
end;
WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: if FCommonData.Skinned then begin
FCommonData.FFocused := (Message.Msg = CM_ENTER) or (Message.Msg = WM_SETFOCUS);
FCommonData.FMouseAbove := False;
FCommonData.BGChanged := True;
Repaint;
if not Scrolling then RefreshScrolls;
end;
WM_NCPAINT : begin
Message.Result := 1;
end;
WM_ERASEBKGND : begin
Message.Result := 1;
end;
SM_GETCACHE : begin
GlobalCacheInfo.Bmp := FCommonData.FCacheBmp;
GlobalCacheInfo.X := 0;
GlobalCacheInfo.Y := 0;
GlobalCacheInfo.Ready := True;
Message.Result := 1;
end;
SM_REMOVESKIN : if not (csDestroying in ComponentState) then begin
FCommonData.BorderIndex := -1;
FCommonData.SkinIndex := -1;
FCommonData.RegionChanged := True;
RefreshScrolls;
RecreateWnd;
end;
end;
end;
if Message.Result <> 1 then begin
if Assigned(FCommonData) then FCommonData.WndProc(Message);
inherited;
end;
case Message.Msg of
SM_REMOVESKIN : if not (csDestroying in ComponentState) then begin
FCommonData.BorderIndex := -1;
FCommonData.SkinIndex := -1;
FCommonData.RegionChanged := True;
RefreshScrolls;
RecreateWnd;
end;
end;
end;
end;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -