?? sscrollbox.pas
字號:
unit sScrollBox;
{$I sDefs.inc}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, sPanel, sScrollBar, sCommonData;
type
TsScrollBox = class(TScrollingWinControl)
private
FBorderStyle: TBorderStyle;
FCanvas: TControlCanvas;
FCommonData : TsCommonData;
VertOffset : integer;
HorzOffset : integer;
RangeY : integer;
RangeX : integer;
Scrolling : boolean;
procedure OnVSBChange(Sender : TObject; OldValue : integer);
procedure OnHSBChange(Sender : TObject; OldValue : integer);
procedure SetBorderStyle(const Value: TBorderStyle);
function GetCanvas: TCanvas;
protected
procedure RefreshScrolls;
function GetVScrollInfo : TsScrollInfo;
function GetHScrollInfo : TsScrollInfo;
procedure ClearOffset(Kind : TScrollBarKind);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
public
VSBar : TsScrollBar;
HSBar : TsScrollBar;
Grip : TsGrip;
constructor Create(AOwner: TComponent); override;
procedure CreateParams(var Params: TCreateParams); override;
destructor Destroy; override;
procedure AfterConstruction; override;
procedure Loaded; override;
property Canvas: TCanvas read GetCanvas;
procedure Invalidate; override;
// procedure PaintWindow(DC: HDC); override;
procedure PrepareCache;
procedure Paint;
procedure WndProc (var Message: TMessage); override;
published
property Align;
property Anchors;
property AutoScroll;
property AutoSize;
property BiDiMode;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
property CommonData : TsCommonData read FCommonData write FCommonData;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Color nodefault;
property Ctl3D;
property Font;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
implementation
uses sGraphUtils, sConst, sMaskData, sVCLUtils, sUtils, sStyleSimply, math,
sMessages, sShowMessages, sStoreUtils;
{ TsScrollBox }
procedure TsScrollBox.AfterConstruction;
begin
inherited AfterConstruction;
CommonData.Loaded;
// RefreshScrolls;
end;
procedure TsScrollBox.ClearOffset(Kind: TScrollBarKind);
begin
case Kind of
sbVertical : begin
if Assigned(VSBar) then begin
// ! Exception arises if called in WndProc... Serge
if not (csDesigning in ComponentState) then begin
VSBar.Visible := False;
end
else begin
if Assigned(VSBar) then FreeAndNil(VSBar);
end;
end;
end
else begin
if Assigned(HSBar) then begin
// ! Exception arises if destroying called in WndProc... Serge
if not (csDesigning in ComponentState) then begin
HSBar.Visible := False;
end
else begin
if Assigned(HSBar) then FreeAndNil(HSBar);
end;
end;
end;
end;
end;
constructor TsScrollBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCommonData := TsCommonData.Create(Self, True);
FCommonData.COC := COC_TsScrollBox;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks, csOpaque];
Width := 185;
Height := 41;
FCanvas := TControlCanvas.Create;
FCanvas.Control := Self;
RangeY := 0;
RangeX := 0;
FBorderStyle := bsNone;
end;
procedure TsScrollBox.CreateParams(var Params: TCreateParams);
const
BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
inherited CreateParams(Params);
with Params do begin
Style := Style or BorderStyles[FBorderStyle];
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
end;
end;
end;
destructor TsScrollBox.Destroy;
begin
if Assigned(FCommonData) then FreeAndNil(FCommonData);
if Assigned(FCanvas) then FreeAndNil(FCanvas);
inherited Destroy;
end;
function TsScrollBox.GetCanvas: TCanvas;
begin
Result := FCanvas;
end;
function TsScrollBox.GetHScrollInfo: TsScrollInfo;
var
i : integer;
Margin : integer;
SBI_H : TScrollBarInfo;
w : integer;
begin
Result.Visible := False;
if not Assigned(HorzScrollBar) or not HorzScrollBar.IsScrollBarVisible then Exit;
Margin := 1 + integer((BorderStyle <> bsNone) and Ctl3d);
Result.Range := HorzScrollBar.Range;
SBI_H.cbSize := SizeOf(TScrollBarInfo);
if not GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), SBI_H) then Exit;
w := WidthOf(SBI_H.rcScrollBar);
Result.Page := w;//Width - 2;
Result.Max := Result.Range - Result.Page;
if Result.Max < 1 then begin
Result.Visible := False;
Exit;
end;
i := GetSystemMetrics(SM_CYHSCROLL);
Result.Rect := Rect(
Left,
Top + Height - i - Margin,
Left + w,
Top + Height
);
Result.Visible := True;
end;
function TsScrollBox.GetVScrollInfo: TsScrollInfo;
var
i : integer;
Margin : integer;
SBI_V : TScrollBarInfo;
h : integer;
begin
Result.Visible := False;
if not Assigned(VertScrollBar) or not VertScrollBar.IsScrollBarVisible or ((csDesigning in ComponentState) and not ControlIsReady(Self)) then Exit;
Margin := 1 + integer((BorderStyle <> bsNone) and Ctl3d);
Result.Range := VertScrollBar.Range;
SBI_V.cbSize := SizeOf(TScrollBarInfo);
if not GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), SBI_V) then Exit;
h := HeightOf(SBI_V.rcScrollBar);
Result.Page := h;//Height - 2;
Result.Max := Result.Range - Result.Page;
if Result.Max < 1 then begin
Result.Visible := False;
Exit;
end;
i := GetSystemMetrics(SM_CXVSCROLL);
if BiDiMode = bdRightToLeft then begin
Result.Rect := Rect(
Left,
Top,
Left + i + Margin,
Top + h//Height
);
end
else begin
Result.Rect := Rect(
Left + Width - i - Margin,
Top,
Left + Width,
Top + h
);
end;
Result.Visible := True;
end;
procedure TsScrollBox.Invalidate;
begin
inherited;
// RefreshScrolls;
end;
procedure TsScrollBox.Loaded;
begin
inherited Loaded;
FCommonData.Loaded;
// RefreshScrolls;
end;
procedure TsScrollBox.OnHSBChange(Sender: TObject; OldValue: integer);
begin
if Assigned(HSBar) then begin
Scrolling := True;
HSBar.DrawingForbidden := True;
inc(HorzOffset, OldValue - HSBar.Position);
SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, HSBar.Position), 0);
if Assigned(HSBar) then begin
HSBar.DrawingForbidden := False;
end else Exit;
Scrolling := False;
CommonData.BgChanged := False;
if not HSBar.DontChange then begin
Repaint;
end;
end;
end;
procedure TsScrollBox.OnVSBChange(Sender: TObject; OldValue: integer);
begin
if Assigned(VSBar) then begin
Scrolling := True;
VSBar.DrawingForbidden := True;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -