再说：TAQSkinScrollBar 类美化滚动条，http://www.138soft.com/?p=156 里面有人提到不可以滚动
滚动的改善方法：
unit AQSkinScrollBar;
(*
说明：本单元提取自TdsaSkinAdapter控件，版权归原作者所有。
提取：www.138soft.com
*)
{$R Scroll.RES}
interface
uses
ComCtrls,
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;
const
// Billenium Effects messages
BE_ID = $41A2;
BE_BASE = CM_BASE + $0C4A;
CM_BENCPAINT = BE_BASE + 1;
CM_SENCPAINT = CM_BASE + 457;
type
TStretchType = (stFull, stHorz, stVert);
TAQSkinScrollBarControl = record
SkinRect: TRect;
//============================
LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
ClRect: TRect;
StretchEffect: Boolean;
LeftStretch, TopStretch, RightStretch, BottomStretch: Boolean;
StretchType: TStretchType;
//============================
TrackArea: TRect;
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
ThumbRect, ActiveThumbRect, DownThumbRect: TRect;
ThumbOffset1, ThumbOffset2: Integer;
GlyphRect, ActiveGlyphRect, DownGlyphRect: TRect;
GlyphTransparent: Boolean;
GlyphTransparentColor: TColor;
ThumbTransparent: Boolean;
ThumbTransparentColor: TColor;
ThumbStretchEffect: Boolean;
ThumbMinSize: Integer;
ThumbMinPageSize: Integer;
end;
type
TScrollButtonDrawState = (
bsasbNormal,
bsasbPressed,
bsasbHot,
bsasbDisabled
);
type
TAQSkinScrollBar = class(TObject)
private
FControl: TControl;
FHandle: THandle;
FHandled: Boolean;
FOldWinProc: TWndMethod;
SMouseInControl: Boolean;
lbtndown: Boolean;
procedure SetControl(Value: TControl);
procedure NewWindowProc(var Message: TMessage);
private
FKind: TScrollBarKind;
procedure DrawBorder(ADC: HDC; AUseExternalDC: Boolean);
procedure DrawButton(Cnvs: TCanvas; i: Integer);
function GetBoundsRect: TRect;
function GetBorderTopLeft: TPoint;
function HaveBorder: Boolean;
function GetHeight: Integer;
function GetWidth: Integer;
function GetEnabled: Boolean;
protected
FOldPos: Integer;
FCurPos, LVOldCurPos: single;
VScrollWnd, HScrollWnd: TWinControl;
VSliderState, VUpState, VDownState: TScrollButtonDrawState;
HSliderState, HUpState, HDownState: TScrollButtonDrawState;
function VScrollDisabled: Boolean;
function HScrollDisabled: Boolean;
function VDownButtonRect: TRect;
function VScrollRect: TRect;
function VSliderRect: TRect;
function VTrackRect: TRect;
function VUpButtonRect: TRect;
function HDownButtonRect: TRect;
function HScrollRect: TRect;
function HSliderRect: TRect;
function HTrackRect: TRect;
function HUpButtonRect: TRect;
procedure VDrawScroll(DC: HDC = 0);
procedure HDrawScroll(DC: HDC = 0);
// Billenium
procedure CMBENCPaint(var Message: TMessage); //message CM_BENCPAINT;
// SmartEffects
procedure CMSENCPaint(var Message: TMessage); //message CM_SENCPAINT;
//
procedure WMLButtonDown(var Msg: TWMMouse); //message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Msg: TWMMouse); //message WM_LBUTTONUP;
procedure WMNCLButtonDblClk(var Msg: TWMMouse); //message WM_NCLBUTTONDBLCLK;
procedure WMNCLButtonDown(var Msg: TWMMouse); //message WM_NCLBUTTONDOWN;
procedure WMNCMouseMove(var Msg: TWMNCHitMessage); //message WM_NCMOUSEMOVE;
procedure WMNCLButtonUp(var Msg: TWMMouse); //message WM_NCLBUTTONUP;
procedure WMMouseMove(var Msg: TWMMouse); //message WM_MOUSEMOVE;
procedure WMNCPaint(var Msg: TWMNCPaint); //message WM_NCPAINT;
procedure WMEraseBkgnd(var Msg: TMessage); //message WM_ERASEBKGND;
procedure WMMouseWheel(var Msg: TMessage); //message WM_MOUSEWHEEL;
procedure WMVScroll(var Msg: TMessage); //message WM_VSCROLL;
procedure WMHScroll(var Msg: TMessage); //message WM_HSCROLL;
procedure WMSize(var Msg: TMessage); //message WM_SIZE;
procedure WMKeyDown(var Msg: TMessage); //message WM_KEYDOWN;
procedure WMCAPTURECHANGED(var Msg: TMessage); //message WM_CAPTURECHANGED;
procedure WMVTChangeState(var Msg: TMessage); message WM_APP + 32;
procedure CMVisibleChanged(var Msg: TMessage); //message CM_VISIBLECHANGED;
procedure CMMouseEnter(var Msg: TMessage); //message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); //message CM_MOUSELEAVE;
procedure EMLINEINDEX(var Msg: TMessage); //message EM_LINEINDEX;
procedure WMWindowPosChanging(var Msg: TWMWindowPosChanged); //message WM_WINDOWPOSCHANGING;
procedure WMWindowPosChanged(var Msg: TWMWindowPosChanged); //message WM_WINDOWPOSCHANGED;
procedure OnContextPopupAction(var Message: TMessage);
procedure PaintBorder(Canvas: TCanvas; R: TRect); //override;
function IsPopupWindow: Boolean;
procedure PaintScroll;
procedure UpdateScroll;
procedure Paint(Canvas: TCanvas); //override;
procedure SetHandle(const Value: HWnd); //override;
private
FBmp_Border: TBitmap;
FBmp_skinrect_V: TBitmap;
FBmp_activeupbuttonrect_V: TBitmap;
FBmp_activedownbuttonrect_V: TBitmap;
FBmp_thumbrect_V: TBitmap;
FBmp_activethumbrect_V: TBitmap;
FBmp_skinrect_H: TBitmap;
FBmp_activeupbuttonrect_H: TBitmap;
FBmp_activedownbuttonrect_H: TBitmap;
FBmp_thumbrect_H: TBitmap;
FBmp_activethumbrect_H: TBitmap;
FVScrollCtrl, FHScrollCtrl: TAQSkinScrollBarControl;
FBtnFace: TColor;
public
constructor Create;
destructor Destroy; override;
published
property Control: TControl read FControl write SetControl;
property Handle: THandle read FHandle;
property Handled: Boolean read FHandled write FHandled;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
property Enabled: Boolean read GetEnabled;
end;
TWinScroll = class(TCustomControl)
public
FSubclass: TAQSkinScrollBar;
FVertical: Boolean;
private
protected
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
public
end;
implementation
function RectWidth(R: TRect): Integer;
begin
Result := R.Right - R.Left;
end;
function RectHeight(R: TRect): Integer;
begin
Result := R.Bottom - R.Top;
end;
type
// TStretchType = (stFull, stHorz, stVert);
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
procedure CreateSkinImage(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
B, SB: TBitMap; R: TRect; AW, AH: Integer; ADrawClient: Boolean;
ALeftStretch, ATopStretch, ARightStretch, ABottomStretch,
AClientStretch: Boolean; AStretchType: TStretchType);
var
w, h, rw, rh: Integer;
X, Y, XCnt, YCnt: Integer;
XO, YO: Integer;
R1, R2, R3: TRect;
Buffer, Buffer2: TBitMap;
SaveIndex: Integer;
begin
B.Width := AW;
B.Height := AH;
if (RBPt.X - LTPt.X = 0) or
(RBPt.Y - LTPt.Y = 0) or SB.Empty then Exit;
with B.Canvas do
begin
// Draw lines
// top
if not ATopStretch
then
begin
w := RTPt.X - LTPt.X;
XCnt := (NewRTPt.X - NewLTPt.X) div (RTPt.X - LTPt.X);
for X := 0 to XCnt do
begin
if NewLTPt.X + X * w + w > NewRTPt.X
then XO := NewLTPt.X + X * w + w - NewRTPt.X else XO := 0;
CopyRect(Rect(NewLTPt.X + X * w, 0, NewLTPt.X + X * w + w - XO, NewClRect.Top),
SB.Canvas, Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X - XO, R.Top + ClRect.Top));
end;
end
else
begin
R1 := Rect(NewLTPt.X, 0, NewRTPt.X, NewClRect.Top);
R2 := Rect(R.Left + LTPt.X, R.Top, R.Left + RTPt.X, R.Top + ClRect.Top);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R2);
Buffer.Height := RectHeight(R2);
R3 := Rect(0, 0, Buffer.Width, Buffer.Height);
Buffer.Canvas.CopyRect(R3, SB.Canvas, R2);
StretchDraw(R1, Buffer);
Buffer.Free;
end;
// bottom
if not ABottomStretch
then
begin
w := RBPt.X - LBPt.X;
XCnt := (NewRBPt.X - NewLBPt.X) div (RBPt.X - LBPt.X);
for X := 0 to XCnt do
begin
if NewLBPt.X + X * w + w > NewRBPt.X
then XO := NewLBPt.X + X * w + w - NewRBPt.X else XO := 0;
CopyRect(Rect(NewLBPt.X + X * w, NewClRect.Bottom, NewLBPt.X + X * w + w - XO, AH),
SB.Canvas, Rect(R.Left + LBPt.X, R.Top + ClRect.Bottom,
R.Left + RBPt.X - XO, R.Bottom));
end;
end
else
begin
R1 := Rect(NewLBPt.X, NewClRect.Bottom, NewRBPt.X, AH);
R2 := Rect(R.Left + LBPt.X, R.Top + ClRect.Bottom, R.Left + RBPt.X, R.Bottom);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R2);
Buffer.Height := RectHeight(R2);
R3 := Rect(0, 0, Buffer.Width, Buffer.Height);
Buffer.Canvas.CopyRect(R3, SB.Canvas, R2);
StretchDraw(R1, Buffer);
Buffer.Free;
end;
// left
if not ALeftStretch
then
begin
w := NewClRect.Left;
h := LBPt.Y - LTPt.Y;
YCnt := (NewLBPt.Y - NewLTPt.Y) div h;
for Y := 0 to YCnt do
begin
if NewLTPt.Y + Y * h + h > NewLBPt.Y
then YO := NewLTPt.Y + Y * h + h - NewLBPt.Y else YO := 0;
CopyRect(Rect(0, NewLTPt.Y + Y * h, w, NewLTPt.Y + Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
end
end
else
begin
R1 := Rect(0, NewLTPt.Y, NewClRect.Left, NewLBPt.Y);
R2 := Rect(R.Left, R.Top + LtPt.Y, R.Left + ClRect.Left, R.Top + LBPt.Y);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R2);
Buffer.Height := RectHeight(R2);
R3 := Rect(0, 0, Buffer.Width, Buffer.Height);
Buffer.Canvas.CopyRect(R3, SB.Canvas, R2);
StretchDraw(R1, Buffer);
Buffer.Free;
end;
// right
if not ARightStretch
then
begin
h := RBPt.Y - RTPt.Y;
YCnt := (NewRBPt.Y - NewRTPt.Y) div h;
for Y := 0 to YCnt do
begin
if NewRTPt.Y + Y * h + h > NewRBPt.Y
then YO := NewRTPt.Y + Y * h + h - NewRBPt.Y else YO := 0;
CopyRect(Rect(NewClRect.Right, NewRTPt.Y + Y * h,
AW, NewRTPt.Y + Y * h + h - YO),
SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
R.Right, R.Top + RBPt.Y - YO));
end
end
else
begin
R1 := Rect(NewClRect.Right, NewRTPt.Y, AW, NewRBPt.Y);
R2 := Rect(R.Left + ClRect.Right, R.Top + RtPt.Y, R.Right, R.Top + RBPt.Y);
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R2);
Buffer.Height := RectHeight(R2);
R3 := Rect(0, 0, Buffer.Width, Buffer.Height);
Buffer.Canvas.CopyRect(R3, SB.Canvas, R2);
StretchDraw(R1, Buffer);
Buffer.Free;
end;
// Draw corners
// lefttop
CopyRect(Rect(0, 0, NewLTPt.X, NewClRect.Top),
SB.Canvas, Rect(R.Left, R.Top,
R.Left + LTPt.X, R.Top + ClRect.Top));
CopyRect(Rect(0, NewClRect.Top, NewClRect.Left, NewLTPt.Y),
SB.Canvas, Rect(R.Left, R.Top + ClRect.Top,
R.Left + ClRect.left, R.Top + LTPT.Y));
//topright
CopyRect(Rect(NewRTPt.X, 0, AW, NewClRect.Top), SB.Canvas,
Rect(R.Left + RTPt.X, R.Top, R.Right, R.Top + ClRect.Top));
CopyRect(Rect(NewClRect.Right, NewClRect.Top, AW, NewRTPt.Y), SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
R.Right, R.Top + RTPt.Y));
//leftbottom
CopyRect(Rect(0, NewLBPt.Y, NewClRect.Left, AH), SB.Canvas,
Rect(R.Left, R.Top + LBPt.Y, R.Left + ClRect.Left, R.Bottom));
CopyRect(Rect(NewClRect.Left, NewClRect.Bottom, NewLBPt.X, AH), SB.Canvas,
Rect(R.Left + ClRect.Left, R.Top + ClRect.Bottom, R.Left + LBPt.X, R.Bottom));
//rightbottom
CopyRect(Rect(NewRBPt.X, NewClRect.Bottom, AW, AH), SB.Canvas,
Rect(R.Left + RBPt.X, R.Top + ClRect.Bottom, R.Right, R.Bottom));
CopyRect(Rect(NewClRect.Right, NewRBPt.Y, AW, NewClRect.Bottom), SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
R.Right, R.Top + ClRect.Bottom));
//Draw client
if ADrawClient
then
if AClientStretch
then
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(ClRect);
Buffer.Height := RectHeight(ClRect);
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
SB.Canvas, Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
R.Left + ClRect.Right, R.Top + ClRect.Bottom));
if (RectWidth(NewClRect) > 0) and (RectHeight(NewClRect) > 0) then
case AStretchType of
stFull:
StretchDraw(NewClRect, Buffer);
stHorz:
begin
SaveIndex := SaveDC(B.Canvas.Handle);
IntersectClipRect(B.Canvas.Handle,
NewCLRect.Left, NewCLRect.Top, NewCLRect.Right, NewClRect.Bottom);
//
Buffer2 := TBitMap.Create;
Buffer2.Width := Buffer.Width;
Buffer2.Height := RectHeight(NewClRect);
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
XCnt := RectWidth(NewClRect) div Buffer2.Width;
for X := 0 to XCnt do
B.Canvas.Draw(NewClRect.Left + X * Buffer2.Width, NewClRect.Top, Buffer2);
Buffer2.Free;
//
RestoreDC(B.Canvas.Handle, SaveIndex);
end;
stVert:
begin
SaveIndex := SaveDC(B.Canvas.Handle);
IntersectClipRect(B.Canvas.Handle,
NewCLRect.Left, NewCLRect.Top, NewCLRect.Right, NewClRect.Bottom);
//
Buffer2 := TBitMap.Create;
Buffer2.Width := RectWidth(NewClRect);
Buffer2.Height := Buffer.Height;
Buffer2.Canvas.StretchDraw(Rect(0, 0, Buffer2.Width, Buffer2.Height), Buffer);
YCnt := RectHeight(NewClRect) div Buffer2.Height;
for Y := 0 to YCnt do
B.Canvas.Draw(NewClRect.Left, NewClRect.Top + Y * Buffer2.Height, Buffer2);
Buffer2.Free;
//
RestoreDC(B.Canvas.Handle, SaveIndex);
end;
end;
Buffer.Free;
end
else
begin
w := RectWidth(ClRect);
h := RectHeight(ClRect);
rw := RectWidth(NewClRect);
rh := RectHeight(NewClRect);
// Draw client area
XCnt := rw div w;
YCnt := rh div h;
for X := 0 to XCnt do
for Y := 0 to YCnt do
begin
if X * w + w > rw then XO := X * W + W - rw else XO := 0;
if Y * h + h > rh then YO := Y * h + h - rh else YO := 0;
CopyRect(Rect(NewClRect.Left + X * w, NewClRect.Top + Y * h,
NewClRect.Left + X * w + w - XO,
NewClRect.Top + Y * h + h - YO),
SB.Canvas,
Rect(R.Left + ClRect.Left, R.Top + ClRect.Top,
R.Left + ClRect.Right - XO,
R.Top + ClRect.Bottom - YO));
end;
end;
end;
end;
procedure CreateStretchImage(B: TBitMap; SB: TBitMap; R: TRect; ClRect: TRect;
ADrawClient: Boolean);
var
LTPt, RTPt, LBPt, RBPt: TPoint;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint;
NewClRect: TRect;
begin
LtPt := Point(ClRect.Left, ClRect.Top);
RtPt := Point(ClRect.Right, ClRect.Top);
LBPt := Point(ClRect.Left, ClRect.Bottom);
RBPt := Point(ClRect.Right, ClRect.Bottom);
NewClRect := ClRect;
NewClRect.Right := B.Width - (RectWidth(R) - ClRect.Right);
NewClRect.Bottom := B.Height - (RectHeight(R) - ClRect.Bottom);
NewLtPt := Point(NewClRect.Left, NewClRect.Top);
NewRtPt := Point(NewClRect.Right, NewClRect.Top);
NewLBPt := Point(NewClRect.Left, NewClRect.Bottom);
NewRBPt := Point(NewClRect.Right, NewClRect.Bottom);
CreateSkinImage(LtPt, RTPt, LBPt, RBPt, ClRect,
NewLTPt, NewRTPt, NewLBPt, NewRBPt, NewClRect,
B, SB, R, B.Width, B.Height, ADrawClient,
True, True, True, True, True, stFull);
end;
procedure CreateHSkinImage(LO, RO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
var
X, XCnt, w, XO: Integer;
R1: TRect;
Buffer: TBitMap;
begin
B.Width := AW;
B.Height := RectHeight(R);
with B.Canvas do
begin
if LO <> 0 then
CopyRect(Rect(0, 0, LO, B.Height), SB.Canvas,
Rect(R.Left, R.Top, R.Left + LO, R.Bottom));
if RO <> 0 then
CopyRect(Rect(B.Width - RO, 0, B.Width, B.Height),
SB.Canvas,
Rect(R.Right - RO, R.Top, R.Right, R.Bottom));
Inc(R.Left, LO);
Dec(R.Right, RO);
w := RectWidth(R);
if w = 0 then w := 1;
XCnt := (B.Width - LO - RO) div w;
if AStretch
then
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R);
Buffer.Height := RectHeight(R);
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
SB.Canvas, R);
R1 := Rect(LO, 0, B.Width - RO, B.Height);
B.Canvas.StretchDraw(R1, Buffer);
Buffer.Free;
end
else
for X := 0 to XCnt do
begin
if LO + X * w + w > B.Width - RO
then XO := LO + X * w + w - (B.Width - RO)
else XO := 0;
B.Canvas.CopyRect(Rect(LO + X * w, 0, LO + X * w + w - XO,
B.Height),
SB.Canvas,
Rect(R.Left, R.Top, R.Right - XO, R.Bottom));
end;
end;
end;
procedure CreateVSkinImage(TpO, BO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
var
Y, YCnt, h, YO: Integer;
R1: TRect;
Buffer: TBitMap;
begin
B.Width := RectWidth(R);
B.Height := AH;
with B.Canvas do
begin
if TpO <> 0 then
CopyRect(Rect(0, 0, B.Width, TpO), SB.Canvas,
Rect(R.Left, R.Top, R.Right, R.Top + TpO));
if BO <> 0 then
CopyRect(Rect(0, B.Height - BO, B.Width, B.Height),
SB.Canvas,
Rect(R.Left, R.Bottom - BO, R.Right, R.Bottom));
Inc(R.Top, TpO);
Dec(R.Bottom, BO);
h := RectHeight(R);
if H <> 0
then
YCnt := (B.Height - TpO - BO) div h
else
YCnt := 0;
if AStretch
then
begin
Buffer := TBitMap.Create;
Buffer.Width := RectWidth(R);
Buffer.Height := RectHeight(R);
Buffer.Canvas.CopyRect(Rect(0, 0, Buffer.Width, Buffer.Height),
SB.Canvas, R);
R1 := Rect(0, TpO, B.Width, B.Height - BO);
B.Canvas.StretchDraw(R1, Buffer);
Buffer.Free;
end
else
for Y := 0 to YCnt do
begin
if TpO + Y * h + h > B.Height - BO
then YO := TpO + Y * h + h - (B.Height - BO)
else YO := 0;
B.Canvas.CopyRect(
Rect(0, TpO + Y * h, B.Width, TpO + Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top, R.Right, R.Bottom - YO));
end;
end;
end;
procedure DrawGlyph(Cnvs: TCanvas; X, Y: Integer; FGlyph: TBitMap;
FNumGlyphs, FGlyphNum: Integer);
var
B: TBitMap;
gw, gh: Integer;
GR: TRect;
begin
if FGlyph.Empty then Exit;
gw := FGlyph.Width div FNumGlyphs;
gh := FGlyph.Height;
B := TBitMap.Create;
B.Width := gw;
B.Height := gh;
GR := Rect(gw * (FGlyphNum - 1), 0, gw * FGlyphNum, gh);
B.Canvas.CopyRect(Rect(0, 0, gw, gh), FGlyph.Canvas, GR);
B.Transparent := True;
Cnvs.Draw(X, Y, B);
B.Free;
end;
procedure CreateSkinBorderImages(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
LeftB, TopB, RightB, BottomB, SB: TBitMap; R: TRect; AW, AH: Integer;
LS, TS, RS, BS: Boolean);
var
XCnt, YCnt, i, X, Y, XO, YO, w, h: Integer;
TB: TBitMap;
TR, TR1: TRect;
begin
// top
w := AW;
h := NewClRect.Top;
if (w > 0) and (h > 0) and (RTPt.X - LTPt.X > 0) then
begin
TopB.Width := w;
TopB.Height := h;
w := RTPt.X - LTPt.X;
XCnt := TopB.Width div w;
if TS then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X, R.Top + h);
TR1 := Rect(NewLTPt.X, 0, NewRTPt.X, h);
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
TopB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for X := 0 to XCnt do
begin
if X * w + w > TopB.Width
then XO := X * w + w - TopB.Width else XO := 0;
with TopB.Canvas do
begin
CopyRect(Rect(X * w, 0, X * w + w - XO, h),
SB.Canvas,
Rect(R.Left + LTPt.X, R.Top,
R.Left + RTPt.X - XO, R.Top + h));
end;
end;
with TopB.Canvas do
begin
CopyRect(Rect(0, 0, NewLTPt.X, h), SB.Canvas,
Rect(R.Left, R.Top, R.Left + LTPt.X, R.Top + h));
CopyRect(Rect(NewRTPt.X, 0, TopB.Width, h), SB.Canvas,
Rect(R.Left + RTPt.X, R.Top, R.Right, R.Top + h));
end;
end;
// bottom
w := AW;
h := AH - NewClRect.Bottom;
if (w > 0) and (h > 0) and (RBPt.X - LBPt.X > 0)
then
begin
BottomB.Width := w;
BottomB.Height := h;
w := RBPt.X - LBPt.X;
XCnt := BottomB.Width div w;
if BS then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + LBPt.X, R.Bottom - h,
R.Left + RBPt.X, R.Bottom);
TR1 := Rect(NewLBPt.X, 0, NewRBPt.X, h);
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
BottomB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for X := 0 to XCnt do
begin
if X * w + w > BottomB.Width
then XO := X * w + w - BottomB.Width else XO := 0;
with BottomB.Canvas do
begin
CopyRect(Rect(X * w, 0, X * w + w - XO, h),
SB.Canvas,
Rect(R.Left + LBPt.X, R.Bottom - h,
R.Left + RBPt.X - XO, R.Bottom));
end;
end;
with BottomB.Canvas do
begin
CopyRect(Rect(0, 0, NewLBPt.X, h), SB.Canvas,
Rect(R.Left, R.Bottom - h, R.Left + LBPt.X, R.Bottom));
CopyRect(Rect(NewRBPt.X, 0, BottomB.Width, h), SB.Canvas,
Rect(R.Left + RBPt.X, R.Bottom - h, R.Right, R.Bottom));
end;
end;
// draw left
h := AH - BottomB.Height - TopB.Height;
w := NewClRect.Left;
if (w > 0) and (h > 0) and (LBPt.Y - LTPt.Y > 0)
then
begin
LeftB.Width := w;
LeftB.Height := h;
h := LBPt.Y - LTPt.Y;
YCnt := LeftB.Height div h;
if LS then
begin
TB := TBitMap.Create;
TR := Rect(R.Left, R.Top + LTPt.Y,
R.Left + w, R.Top + LBPt.Y);
TR1 := Rect(0, LTPt.Y - ClRect.Top, w,
LeftB.Height - (ClRect.Bottom - LBPt.Y));
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
LeftB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for Y := 0 to YCnt do
begin
if Y * h + h > LeftB.Height
then YO := Y * h + h - LeftB.Height else YO := 0;
with LeftB.Canvas do
CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
SB.Canvas,
Rect(R.Left, R.Top + LTPt.Y, R.Left + w, R.Top + LBPt.Y - YO));
end;
with LeftB.Canvas do
begin
YO := LTPt.Y - ClRect.Top;
if YO > 0
then
CopyRect(Rect(0, 0, w, YO), SB.Canvas,
Rect(R.Left, R.Top + ClRect.Top,
R.Left + w, R.Top + LTPt.Y));
YO := ClRect.Bottom - LBPt.Y;
if YO > 0 then
CopyRect(Rect(0, LeftB.Height - YO, w, LeftB.Height),
SB.Canvas,
Rect(R.Left, R.Top + LBPt.Y,
R.Left + w, R.Top + ClRect.Bottom));
end;
end;
// draw right
h := AH - BottomB.Height - TopB.Height;
w := AW - NewClRect.Right;
if (w > 0) and (h > 0) and (RBPt.Y - RTPt.Y > 0) then
begin
RightB.Width := w;
RightB.Height := h;
h := RBPt.Y - RTPt.Y;
YCnt := RightB.Height div h;
if RS then
begin
TB := TBitMap.Create;
TR := Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
R.Right, R.Top + RBPt.Y);
TR1 := Rect(0, RTPt.Y - ClRect.Top, w,
RightB.Height - (ClRect.Bottom - RBPt.Y));
TB.Width := RectWidth(TR);
TB.Height := RectHeight(TR);
TB.Canvas.CopyRect(Rect(0, 0, TB.Width, TB.Height),
SB.Canvas, TR);
RightB.Canvas.StretchDraw(TR1, TB);
TB.Free;
end
else
for Y := 0 to YCnt do
begin
if Y * h + h > RightB.Height
then YO := Y * h + h - RightB.Height else YO := 0;
with RightB.Canvas do
CopyRect(Rect(0, Y * h, w, Y * h + h - YO),
SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RTPt.Y,
R.Right, R.Top + RBPt.Y - YO));
end;
with RightB.Canvas do
begin
YO := RTPt.Y - ClRect.Top;
if YO > 0 then
CopyRect(Rect(0, 0, w, YO), SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + ClRect.Top,
R.Right, R.Top + RTPt.Y));
YO := ClRect.Bottom - RBPt.Y;
if YO > 0 then
CopyRect(Rect(0, RightB.Height - YO, w, RightB.Height),
SB.Canvas,
Rect(R.Left + ClRect.Right, R.Top + RBPt.Y,
R.Right, R.Top + ClRect.Bottom));
end;
end;
end;
function NullRect: TRect;
begin
Result := Rect(0, 0, 0, 0);
end;
function IsNullRect(R: TRect): Boolean;
begin
Result := (R.Right - R.Left <= 0) or (R.Bottom - R.Top <= 0)
end;
procedure DrawArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor; Code: Integer);
var
i: Integer;
X, Y: Integer;
begin
with Cnvs do
begin
Pen.Color := Color;
case Code of
1:
begin
X := R.Left + RectWidth(R) div 2 - 2;
Y := R.Top + RectHeight(R) div 2;
for i := 0 to 3 do
begin
MoveTo(X + i, Y - i);
LineTo(X + i, Y + i + 1);
end;
end;
2:
begin
X := R.Left + RectWidth(R) div 2 + 2;
Y := R.Top + RectHeight(R) div 2;
for i := 3 downto 0 do
begin
MoveTo(X - i, Y + i);
LineTo(X - i, Y - i - 1);
end;
end;
3:
begin
X := R.Left + RectWidth(R) div 2;
Y := R.Top + RectHeight(R) div 2 - 2;
for i := 0 to 3 do
begin
MoveTo(X - i, Y + i);
LineTo(X + i + 1, Y + i);
end;
end;
4:
begin
X := R.Left + RectWidth(R) div 2;
Y := R.Top + RectHeight(R) div 2 + 2;
for i := 3 downto 0 do
begin
MoveTo(X - i, Y - i);
LineTo(X + i + 1, Y - i);
end;
end;
5: begin
X := R.Left + RectWidth(R) div 2;
Y := R.Top + RectHeight(R) div 2;
MoveTo(X - 4, Y - 1);
LineTo(X + 4, Y - 1);
MoveTo(X - 4, Y);
LineTo(X + 4, Y);
//
MoveTo(X - 1, Y - 4);
LineTo(X - 1, Y + 4);
MoveTo(X, Y - 4);
LineTo(X, Y + 4);
end;
end;
end;
end;
{ TWinScroll }
procedure TWinScroll.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_CHILDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
Params.ExStyle := Params.ExStyle or WS_EX_NOPARENTNOTIFY;
Params.WindowClass.style := Params.WindowClass.style;
end;
procedure TWinScroll.Paint;
begin
if Width * Height = 0 then Exit;
if FSubclass <> nil then
begin
if FVertical then
begin
with FSubclass.VScrollRect do
MoveWindowOrg(Canvas.Handle, -Left, -Top);
FSubclass.VDrawScroll(Canvas.Handle);
with FSubclass.VScrollRect do
MoveWindowOrg(Canvas.Handle, Left, Top);
end
else
begin
with FSubclass.HScrollRect do
MoveWindowOrg(Canvas.Handle, -Left, -Top);
FSubclass.HDrawScroll(Canvas.Handle);
with FSubclass.HScrollRect do
MoveWindowOrg(Canvas.Handle, Left, Top);
end;
end;
end;
procedure TWinScroll.WMEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := 1;
end;
procedure TWinScroll.WMNCHitTest(var Msg: TWMNCHitTest);
begin
Msg.Result := HTTRANSPARENT;
end;
{ TAQSkinScrollBar }
const
BUTCOUNT = 3;
THUMB = 0;
UPBUTTON = 1;
DOWNBUTTON = 2;
TRACK = 3;
CLIENT = 4;
SBUTTONW = 16;
procedure TAQSkinScrollBar.CMBENCPaint(var Message: TMessage);
begin
if (Message.LParam = BE_ID) then
begin
if (Message.wParam <> 0) then
DrawBorder(Message.wParam, True);
Message.Result := BE_ID;
Handled := True;
end
else
begin
Handled := False;
FOldWinProc(TMessage(Message));
end;
end;
procedure TAQSkinScrollBar.CMMouseEnter(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
SMouseInControl := True;
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.CMMouseLeave(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
SMouseInControl := False;
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.CMSENCPaint(var Message: TMessage);
begin
FOldWinProc(TMessage(Message));
if (Message.wParam <> 0) then
begin
DrawBorder(Message.wParam, True);
if HScrollWnd <> nil then
HScrollWnd.PaintTo(Message.wParam,
HScrollWnd.Left - Control.Left, HScrollWnd.Top - Control.Top);
if VScrollWnd <> nil then
VScrollWnd.PaintTo(Message.wParam,
VScrollWnd.Left - Control.Left, VScrollWnd.Top - Control.Top);
end;
end;
procedure TAQSkinScrollBar.CMVisibleChanged(var Msg: TMessage);
begin
if (Control <> nil) and (Control.Visible) then
ShowWindow(VScrollWnd.Handle, SW_SHOW);
if (Control <> nil) and (not Control.Visible) then
ShowWindow(VScrollWnd.Handle, SW_HIDE);
if (Control <> nil) and (Control.Visible) then
ShowWindow(HScrollWnd.Handle, SW_SHOW);
if (Control <> nil) and (not Control.Visible) then
ShowWindow(HScrollWnd.Handle, SW_HIDE);
end;
constructor TAQSkinScrollBar.Create;
begin
FControl := nil;
FHandle := 0;
FOldWinProc := nil;
with FVScrollCtrl do
begin
skinrect := Rect(225, 25, 240, 89);
LTPoint := point(7, 14);
RTPoint := point(0, 0);
LBPoint := point(8, 50);
RBPoint := point(0, 0);
ClRect := Rect(0, 15, 15, 49);
LeftStretch := False;
topstretch := False;
rightstretch := False;
bottomstretch := False;
stretcheffect := False;
stretchtype := stfull;
trackarea := Rect(0, 13, 15, 51);
upbuttonrect := Rect(0, 51, 15, 64);
activeupbuttonrect := Rect(241, 36, 256, 49);
downupbuttonrect := Rect(0, 0, 0, 0);
downbuttonrect := Rect(0, 0, 15, 13);
activedownbuttonrect := Rect(241, 25, 256, 38);
downdownbuttonrect := Rect(0, 0, 0, 0);
thumbrect := Rect(245, 2, 255, 16);
activethumbrect := Rect(228, 2, 238, 16);
downthumbrect := Rect(0, 0, 0, 0);
thumboffset1 := 5;
thumboffset2 := 5;
thumbtransparent := False;
thumbtransparentcolor := 0;
thumbstretcheffect := False;
thumbminsize := 10;
thumbminpagesize := 14;
glyphrect := Rect(0, 0, 0, 0);
activeglyphrect := Rect(0, 0, 0, 0);
downglyphrect := Rect(0, 0, 0, 0);
glyphtransparent := False;
glyphtransparentcolor := 0;
end;
with FHScrollCtrl do
begin
skinrect := Rect(153, 132, 217, 147);
LTPoint := point(14, 5);
RTPoint := point(49, 7);
LBPoint := point(0, 0);
RBPoint := point(0, 0);
ClRect := Rect(16, 1, 48, 14);
LeftStretch := False;
topstretch := False;
rightstretch := False;
bottomstretch := False;
stretcheffect := False;
stretchtype := stfull;
trackarea := Rect(14, 0, 50, 15);
upbuttonrect := Rect(51, 0, 64, 15);
activeupbuttonrect := Rect(164, 148, 177, 163);
downupbuttonrect := Rect(0, 0, 0, 0);
downbuttonrect := Rect(0, 0, 13, 15);
activedownbuttonrect := Rect(153, 148, 166, 163);
downdownbuttonrect := Rect(0, 0, 0, 0);
thumbrect := Rect(133, 151, 147, 161);
activethumbrect := Rect(133, 134, 147, 144);
downthumbrect := Rect(0, 0, 0, 0);
thumboffset1 := 4;
thumboffset2 := 4;
thumbtransparent := False;
thumbtransparentcolor := 0;
thumbstretcheffect := False;
thumbminsize := 10;
thumbminpagesize := 14;
glyphrect := Rect(0, 0, 0, 0);
activeglyphrect := Rect(0, 0, 0, 0);
downglyphrect := Rect(0, 0, 0, 0);
glyphtransparent := False;
glyphtransparentcolor := 0;
end;
FBtnFace := 15852243;
FBmp_Border := TBitmap.Create;
FBmp_Border.LoadFromResourceName(HInstance, ‘memo_skinrect‘);
FBmp_skinrect_V := TBitmap.Create;
FBmp_activeupbuttonrect_V := TBitmap.Create;
FBmp_activedownbuttonrect_V := TBitmap.Create;
FBmp_thumbrect_V := TBitmap.Create;
FBmp_activethumbrect_V := TBitmap.Create;
FBmp_skinrect_V.LoadFromResourceName(HInstance, ‘v_skinrect‘);
FBmp_activeupbuttonrect_V.LoadFromResourceName(HInstance, ‘v_activeupbuttonrect‘);
FBmp_activedownbuttonrect_V.LoadFromResourceName(HInstance, ‘v_activedownbuttonrect‘);
FBmp_thumbrect_V.LoadFromResourceName(HInstance, ‘v_thumbrect‘);
FBmp_activethumbrect_V.LoadFromResourceName(HInstance, ‘v_activethumbrect‘);
FBmp_skinrect_H := TBitmap.Create;
FBmp_activeupbuttonrect_H := TBitmap.Create;
FBmp_activedownbuttonrect_H := TBitmap.Create;
FBmp_thumbrect_H := TBitmap.Create;
FBmp_activethumbrect_H := TBitmap.Create;
FBmp_skinrect_H.LoadFromResourceName(HInstance, ‘h_skinrect‘);
FBmp_activeupbuttonrect_H.LoadFromResourceName(HInstance, ‘h_activeupbuttonrect‘);
FBmp_activedownbuttonrect_H.LoadFromResourceName(HInstance, ‘h_activedownbuttonrect‘);
FBmp_thumbrect_H.LoadFromResourceName(HInstance, ‘h_thumbrect‘);
FBmp_activethumbrect_H.LoadFromResourceName(HInstance, ‘h_activethumbrect‘);
end;
destructor TAQSkinScrollBar.Destroy;
begin
if (FControl <> nil) and (@FOldWinProc <> nil) then FControl.WindowProc := FOldWinProc;
if VScrollWnd <> nil then
begin
TWinScroll(VScrollWnd).FSubclass := nil;
FreeAndNil(VScrollWnd);
end;
if HScrollWnd <> nil then
begin
TWinScroll(HScrollWnd).FSubclass := nil;
FreeAndNil(HScrollWnd);
end;
FBmp_skinrect_V.Free;
FBmp_activeupbuttonrect_V.Free;
FBmp_activedownbuttonrect_V.Free;
FBmp_thumbrect_V.Free;
FBmp_activethumbrect_V.Free;
FBmp_skinrect_H.Free;
FBmp_activeupbuttonrect_H.Free;
FBmp_activedownbuttonrect_H.Free;
FBmp_thumbrect_H.Free;
FBmp_activethumbrect_H.Free;
FBmp_Border.Free;
inherited;
end;
procedure TAQSkinScrollBar.DrawBorder(ADC: HDC; AUseExternalDC: Boolean);
var
R: TRect;
Canvas: TCanvas;
P: TPoint;
begin
if Handle = 0 then Exit;
Canvas := TCanvas.Create;
if not AUseExternalDC
then Canvas.Handle := GetWindowDC(Handle)
else Canvas.Handle := ADC;
P := Point(0, 0);
Windows.ClientToScreen(Handle, P);
Windows.GetWindowRect(Handle, R);
P.X := P.X - R.Left;
P.Y := P.Y - R.Top;
Windows.GetClientRect(Handle, R);
ExcludeClipRect(Canvas.Handle, P.X, P.Y, R.Right - R.Left + P.X, R.Bottom - R.Top + P.Y);
Windows.GetWindowRect(Handle, R);
OffsetRect(R, -R.Left, -R.Top);
PaintBorder(Canvas, R);
SelectClipRgn(Canvas.Handle, 0);
if not AUseExternalDC then ReleaseDC(Handle, Canvas.Handle);
Canvas.Handle := 0;
Canvas.Free;
end;
procedure TAQSkinScrollBar.DrawButton(Cnvs: TCanvas; i: Integer);
const
SP_XP_BTNFRAMECOLOR = 8388608;
SP_XP_BTNACTIVECOLOR = 13811126;
SP_XP_BTNDOWNCOLOR = 11899781;
var
R1, R2: TRect;
C: TColor;
ThumbB: TBitMap;
B1: TBitMap;
kf: Double;
FPageSize: Integer;
SkinCtrl: TAQSkinScrollBarControl;
TrackR, R: TRect;
B: TBitmap;
x, ResizeMode: Integer;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
MinW, MinH: Integer;
GlyphB: TBitMap;
//==============================================
Bmp_skinrect_V: TBitmap;
Bmp_activeupbuttonrect_V: TBitmap;
Bmp_activedownbuttonrect_V: TBitmap;
Bmp_thumbrect_V: TBitmap;
Bmp_activethumbrect_V: TBitmap;
Bmp_r1: TBitmap;
Bmp_skinrect_H: TBitmap;
Bmp_activeupbuttonrect_H: TBitmap;
Bmp_activedownbuttonrect_H: TBitmap;
Bmp_thumbrect_H: TBitmap;
Bmp_activethumbrect_H: TBitmap;
begin
Bmp_skinrect_V := FBmp_skinrect_V;
Bmp_activeupbuttonrect_V := FBmp_activeupbuttonrect_V;
Bmp_activedownbuttonrect_V := FBmp_activedownbuttonrect_V;
Bmp_thumbrect_V := FBmp_thumbrect_V;
Bmp_activethumbrect_V := FBmp_activethumbrect_V;
Bmp_skinrect_H := FBmp_skinrect_H;
Bmp_activeupbuttonrect_H := FBmp_activeupbuttonrect_H;
Bmp_activedownbuttonrect_H := FBmp_activedownbuttonrect_H;
Bmp_thumbrect_H := FBmp_thumbrect_H;
Bmp_activethumbrect_H := FBmp_activethumbrect_H;
if FKind = sbVertical then
begin
SkinCtrl := FVScrollCtrl;
with SkinCtrl do
begin
SkinRect := Rect(0, 0, Bmp_skinrect_V.Width, Bmp_skinrect_V.Height);
ActiveUpButtonRect := Rect(0, 0, Bmp_activeupbuttonrect_V.Width, Bmp_activeupbuttonrect_V.Height);
ActiveDownButtonRect := Rect(0, 0, Bmp_activedownbuttonrect_V.Width, Bmp_activedownbuttonrect_V.Height);
ThumbRect := Rect(0, 0, Bmp_thumbrect_V.Width, Bmp_thumbrect_V.Height);
ActiveThumbRect := Rect(0, 0, Bmp_activethumbrect_V.Width, Bmp_activethumbrect_V.Height);
end;
end
else
begin
SkinCtrl := FHScrollCtrl;
with SkinCtrl do
begin
SkinRect := Rect(0, 0, Bmp_skinrect_H.Width, Bmp_skinrect_H.Height);
ActiveUpButtonRect := Rect(0, 0, Bmp_activeupbuttonrect_H.Width, Bmp_activeupbuttonrect_H.Height);
ActiveDownButtonRect := Rect(0, 0, Bmp_activedownbuttonrect_H.Width, Bmp_activedownbuttonrect_H.Height);
ThumbRect := Rect(0, 0, Bmp_thumbrect_H.Width, Bmp_thumbrect_H.Height);
ActiveThumbRect := Rect(0, 0, Bmp_activethumbrect_H.Width, Bmp_activethumbrect_H.Height);
end;
end;
FPageSize := 20;
{ Offset }
if FKind = sbVertical then
begin
R := VTrackRect;
if RectWidth(SkinCtrl.SkinRect) < RectWidth(R) then
MoveWindowOrg(Cnvs.Handle, RectWidth(R) - RectWidth(SkinCtrl.SkinRect), 0);
end
else
begin
R := HTrackRect;
if RectHeight(SkinCtrl.SkinRect) < RectHeight(R) then
MoveWindowOrg(Cnvs.Handle, 0, RectHeight(R) - RectHeight(SkinCtrl.SkinRect));
end;
if I = CLIENT then
begin
if FKind = sbVertical then
R := VScrollRect
else
R := HScrollRect;
with SkinCtrl do
begin
if IsNullRect(SkinRect) then
ResizeMode := -1
else if (RBPoint.X <> 0) and (RBPoint.Y <> 0) then
ResizeMode := 1
else if (RTPoint.X <> 0) or (RTPoint.Y <> 0) then
ResizeMode := 2
else if (LBPoint.X <> 0) or (LBPoint.Y <> 0) then
ResizeMode := 3
else
ResizeMode := 0;
if RectWidth(R) * RectHEight(R) > 0 then
begin
B := TBitmap.Create;
B.Width := RectWidth(R);
B.Height := RectHeight(R);
R1 := SkinRect;
if FKind = sbVertical then
Bmp_r1 := Bmp_skinrect_V
else
Bmp_r1 := Bmp_skinrect_H;
case ResizeMode of
0:
begin
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), Bmp_r1.Canvas, R1);
end;
1: CreateSkinImage(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, Bmp_r1, R1, B.Width, B.Height, True,
LeftStretch, TopStretch, RightStretch, BottomStretch,
StretchEffect, StretchType);
2: CreateHSkinImage(LTPoint.X, RectWidth(SkinRect) - RTPoint.X,
B, Bmp_r1, R1, B.Width, B.Height, StretchEffect);
3: CreateVSkinImage(LTPoint.Y, RectHeight(SkinRect) - LBPoint.Y,
B, Bmp_r1, R1, B.Width, B.Height, StretchEffect);
end;
Cnvs.Draw(R.Left, R.Top, B);
B.Free;
end;
end; //end for "with SkinCtrl do"
end; //end for "if I = CLIENT then"
if I = THUMB then
begin
if FKind = sbVertical then
begin
if RectHeight(VTrackRect) = 0 then Exit;
R := VSliderRect;
if (VSliderState = bsasbPressed) and (not IsNullRect(SkinCtrl.DownThumbRect)) then
begin
R1 := SkinCtrl.DownThumbRect;
Bmp_r1 := Bmp_skinrect_V; //Add
end
else if (VSliderState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveThumbRect)) then
begin
R1 := SkinCtrl.ActiveThumbRect;
Bmp_r1 := Bmp_activethumbrect_V; //Add
end
else
begin
R1 := SkinCtrl.ThumbRect;
Bmp_r1 := Bmp_thumbrect_V; //Add
end;
TrackR := SkinCtrl.TrackArea;
TrackR.Bottom := RectHeight(VScrollRect) - (RectHeight(SkinCtrl.SkinRect) - SkinCtrl.TrackArea.Bottom);
OffsetRect(TrackR, VScrollRect.Left, VScrollRect.Top);
R.Left := R.Left + SkinCtrl.TrackArea.Left + ((RectWidth(SkinCtrl.TrackArea) - RectWidth(SkinCtrl.ThumbRect)) div 2);
R.Top := TrackR.Top + Round(((R.Top - VTrackRect.Top) / RectHeight(VTrackRect)) * RectHeight(TrackR)) + 1;
R.Bottom := TrackR.Top + Round(((R.Bottom - VTrackRect.Top) / RectHeight(VTrackRect)) * RectHeight(TrackR)) + 1;
MinH := RectHeight(SkinCtrl.ThumbRect);
if SkinCtrl.ThumbMinSize > 0 then MinH := SkinCtrl.ThumbMinSize;
if RectHeight(R) < MinH then
begin
X := ((R.Top + R.Bottom) div 2);
R.Top := X - (MinH div 2);
R.Bottom := X + (MinH div 2);
if R.Bottom > VScrollRect.Bottom - (MinH - SkinCtrl.TrackArea.Bottom) then
begin
R.Bottom := VScrollRect.Bottom - (MinH - SkinCtrl.TrackArea.Bottom);
R.Top := R.Bottom - MinH;
end;
if R.Top < VScrollRect.Top + SkinCtrl.TrackArea.Top then
begin
R.Top := VScrollRect.Top + SkinCtrl.TrackArea.Top;
R.Bottom := R.Top + MinH;
end;
end;
end //end for "if FKind = sbVertical then"
else
begin
R := HSliderRect;
if RectWidth(HTrackRect) = 0 then Exit;
if (HSliderState = bsasbPressed) and (not IsNullRect(SkinCtrl.DownThumbRect)) then
begin
R1 := SkinCtrl.DownThumbRect;
Bmp_r1 := Bmp_skinrect_H; //Add
end
else if (HSliderState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveThumbRect)) then
begin
R1 := SkinCtrl.ActiveThumbRect;
Bmp_r1 := Bmp_activethumbrect_H; //Add
end
else
begin
R1 := SkinCtrl.ThumbRect;
Bmp_r1 := Bmp_thumbrect_H; //Add
end;
TrackR := SkinCtrl.TrackArea;
TrackR.Right := RectWidth(HScrollRect) - (RectWidth(SkinCtrl.SkinRect) - SkinCtrl.TrackArea.Right);
OffsetRect(TrackR, HScrollRect.Left, HScrollRect.Top);
R.Top := R.Top + SkinCtrl.TrackArea.Top + ((RectHeight(SkinCtrl.TrackArea) - RectHeight(SkinCtrl.ThumbRect)) div 2);
R.Left := TrackR.Left + Round(((R.Left - HTrackRect.Left) / RectWidth(HTrackRect)) * RectWidth(TrackR)) + 1;
R.Right := TrackR.Left + Round(((R.Right - HTrackRect.Left) / RectWidth(HTrackRect)) * RectWidth(TrackR)) + 1;
MinW := RectWidth(SkinCtrl.ThumbRect);
if SkinCtrl.ThumbMinSize > 0 then MinW := SkinCtrl.ThumbMinSize;
if RectWidth(R) < MinW then
begin
X := ((R.Left + R.Right) div 2);
R.Left := X - (MinW div 2);
R.Right := X + (MinW div 2);
if R.Right > HScrollRect.Right - (MinW - SkinCtrl.TrackArea.Right) then
begin
R.Right := HScrollRect.Right - (MinW - SkinCtrl.TrackArea.Right);
R.Left := R.Right - MinW;
end;
if R.Left < HScrollRect.Left + SkinCtrl.TrackArea.Left then
begin
R.Left := HScrollRect.Left + SkinCtrl.TrackArea.Left;
R.Right := R.Left + MinW;
end;
end;
end;
if RectHeight(R) * RectWidth(R) > 0 then
begin
ThumbB := TBitMap.Create;
ThumbB.Width := RectWidth(R);
ThumbB.Height := RectHeight(R);
if FPageSize = 0 then
ThumbB.Canvas.CopyRect(Rect(0, 0, ThumbB.Width, ThumbB.Height), Bmp_r1.Canvas, R1)
else
case FKind of
sbHorizontal:
CreateHSkinImage(SkinCtrl.ThumbOffset1, SkinCtrl.ThumbOffset2, ThumbB, Bmp_r1, R1,
ThumbB.Width, ThumbB.Height, SkinCtrl.ThumbStretchEffect);
sbVertical:
CreateVSkinImage(SkinCtrl.ThumbOffset1, SkinCtrl.ThumbOffset2, ThumbB, Bmp_r1, R1,
ThumbB.Width, ThumbB.Height, SkinCtrl.ThumbStretchEffect);
end;
// draw glyph
if FKind = sbVertical then
begin
if (VSliderState = bsasbPressed) and sMouseInControl and (not IsNullRect(SkinCtrl.DownGlyphRect)) then
begin
R1 := SkinCtrl.DownGlyphRect;
Bmp_r1 := Bmp_skinrect_V; //Add
end
else if (VSliderState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveGlyphRect)) then
begin
R1 := SkinCtrl.ActiveGlyphRect;
Bmp_r1 := Bmp_skinrect_V; //Add
end
else
begin
R1 := SkinCtrl.GlyphRect;
Bmp_r1 := Bmp_skinrect_V; //Add
end;
end
else
begin
if (HSliderState = bsasbPressed) and sMouseInControl and (not IsNullRect(SkinCtrl.DownGlyphRect)) then
begin
R1 := SkinCtrl.DownGlyphRect;
Bmp_r1 := Bmp_skinrect_H; //Add
end
else
if (HSliderState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveGlyphRect)) then
begin
R1 := SkinCtrl.ActiveGlyphRect;
Bmp_r1 := Bmp_skinrect_H; //Add
end
else
begin
R1 := SkinCtrl.GlyphRect;
Bmp_r1 := Bmp_skinrect_H; //Add
end;
end;
if not IsNullRect(R1) then
begin
R2 := Rect(ThumbB.Width div 2 - RectWidth(R1) div 2,
ThumbB.Height div 2 - RectHeight(R1) div 2,
ThumbB.Width div 2 - RectWidth(R1) div 2 + RectWidth(R1),
ThumbB.Height div 2 - RectHeight(R1) div 2 + RectHeight(R1));
if SkinCtrl.GlyphTransparent then
begin
GlyphB := TBitMap.Create;
GlyphB.Width := RectWidth(R1);
GlyphB.Height := RectHeight(R1);
GlyphB.Canvas.CopyRect(Rect(0, 0, GlyphB.Width, GlyphB.Height),
Bmp_r1.Canvas, R1);
GlyphB.Transparent := True;
GlyphB.TransparentMode := tmFixed;
GlyphB.TransparentColor := SkinCtrl.GlyphTransparentColor;
ThumbB.Canvas.Draw(R2.Left, R2.Top, GlyphB);
GlyphB.Free;
end
else
ThumbB.Canvas.CopyRect(R2, Bmp_r1.Canvas, R1);
end;
//
if SkinCtrl.ThumbTransparent then
begin
ThumbB.Transparent := True;
ThumbB.TransparentMode := tmFixed;
ThumbB.TransparentColor := SkinCtrl.ThumbTransparentColor;
end;
Cnvs.Draw(R.Left, R.Top, ThumbB);
ThumbB.Free;
end;
end
else
begin
R1 := NullRect;
if FKind = sbVertical then
Bmp_r1 := Bmp_skinrect_V //Add
else
Bmp_r1 := Bmp_skinrect_H; //Add
if FKind = sbVertical then
begin
case I of
UPBUTTON:
begin
if (VUpState = bsasbPressed) and sMouseInControl then
begin
R1 := SkinCtrl.DownUpButtonRect;
Bmp_r1 := Bmp_skinrect_V; //Add
if IsNullRect(R1) then
begin
R1 := SkinCtrl.ActiveUpButtonRect;
Bmp_r1 := Bmp_activeupbuttonrect_V; //Add
end;
end
else
if (VUpState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveUpButtonRect)) then
begin
R1 := SkinCtrl.ActiveUpButtonRect;
Bmp_r1 := Bmp_activeupbuttonrect_V; //Add
end
else
begin
R1 := SkinCtrl.UpButtonRect;
Bmp_r1 := Bmp_skinrect_V; //Add
OffsetRect(R1, SkinCtrl.SkinRect.Left, SkinCtrl.SkinRect.Top);
end;
R := VDownButtonRect;
OffsetRect(R, SkinCtrl.UpButtonRect.Left, RectHeight(R) - (RectHeight(SkinCtrl.SkinRect) - SkinCtrl.UpButtonRect.Top));
end;
DOWNBUTTON:
begin
if (VDownState = bsasbPressed) and sMouseInControl then
begin
R1 := SkinCtrl.DownDownButtonRect;
Bmp_r1 := Bmp_skinrect_V; //Add
if IsNullRect(R1) then
begin
R1 := SkinCtrl.ActiveDownButtonRect;
Bmp_r1 := Bmp_activedownbuttonrect_V; //Add
end;
end
else if (VDownState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveUpButtonRect)) then
begin
R1 := SkinCtrl.ActiveDownButtonRect;
Bmp_r1 := Bmp_activedownbuttonrect_V; //Add
end
else
begin
R1 := SkinCtrl.DownButtonRect;
Bmp_r1 := Bmp_skinrect_V; //Add
OffsetRect(R1, SkinCtrl.SkinRect.Left, SkinCtrl.SkinRect.Top);
end;
R := VUpButtonRect;
OffsetRect(R, SkinCtrl.DownButtonRect.Left, SkinCtrl.DownButtonRect.Top);
end
end;
end
else
begin
case I of
UPBUTTON:
begin
if (HUpState = bsasbPressed) and sMouseInControl then
begin
R1 := SkinCtrl.DownUpButtonRect;
Bmp_r1 := Bmp_skinrect_H; //Add
if IsNullRect(R1) then
begin
R1 := SkinCtrl.ActiveUpButtonRect;
Bmp_r1 := Bmp_activeupbuttonrect_H; //Add
end;
end
else
if (HUpState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveUpButtonRect)) then
begin
R1 := SkinCtrl.ActiveUpButtonRect;
Bmp_r1 := Bmp_activeupbuttonrect_H; //Add
end
else
begin
R1 := SkinCtrl.UpButtonRect;
Bmp_r1 := Bmp_skinrect_H; //Add
OffsetRect(R1, SkinCtrl.SkinRect.Left, SkinCtrl.SkinRect.Top);
end;
R := HDownButtonRect;
OffsetRect(R, RectWidth(R) - (RectWidth(SkinCtrl.SkinRect) - SkinCtrl.UpButtonRect.Left), SkinCtrl.UpButtonRect.Top);
end;
DOWNBUTTON:
begin
if (HDownState = bsasbPressed) and sMouseInControl then
begin
R1 := SkinCtrl.DownDownButtonRect;
Bmp_r1 := Bmp_skinrect_H; //Add
if IsNullRect(R1) then
begin
R1 := SkinCtrl.ActiveDownButtonRect;
Bmp_r1 := Bmp_activedownbuttonrect_H; //Add
end;
end
else
if (HDownState = bsasbHot) and sMouseInControl and (not IsNullRect(SkinCtrl.ActiveUpButtonRect)) then
begin
R1 := SkinCtrl.ActiveDownButtonRect;
Bmp_r1 := Bmp_activedownbuttonrect_H; //Add
end
else
begin
R1 := SkinCtrl.DownButtonRect;
Bmp_r1 := Bmp_skinrect_H; //Add
OffsetRect(R1, SkinCtrl.SkinRect.Left, SkinCtrl.SkinRect.Top);
end;
R := HUpButtonRect;
OffsetRect(R, SkinCtrl.DownButtonRect.Left, SkinCtrl.DownButtonRect.Top);
end
end;
end;
if not IsNullRect(R1) then
BitBlt(Cnvs.Handle, R.Left, R.Top, RectWidth(R1), RectHeight(R1), Bmp_r1.Canvas.Handle,
R1.Left, R1.Top, SRCCOPY);
end;
{ Restore Offset }
if FKind = sbVertical then
begin
R := VTrackRect;
if RectWidth(SkinCtrl.SkinRect) < RectWidth(R) then
MoveWindowOrg(Cnvs.Handle, -(RectWidth(R) - RectWidth(SkinCtrl.SkinRect)), 0);
end
else
begin
R := HTrackRect;
if RectHeight(SkinCtrl.SkinRect) < RectHeight(R) then
MoveWindowOrg(Cnvs.Handle, 0, -(RectHeight(R) - RectHeight(SkinCtrl.SkinRect)));
end;
end;
procedure TAQSkinScrollBar.EMLINEINDEX(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
end;
function TAQSkinScrollBar.GetBorderTopLeft: TPoint;
var
PWnd: HWnd;
CP, PP: TPoint;
begin
Result := Point(0, 0);
PWnd := GetParent(Handle);
CP := Point(0, 0);
ClientToScreen(Handle, CP);
with GetBoundsRect do
PP := Point(Left, Top);
ClientToScreen(PWnd, PP);
Result := Point(CP.X - PP.X, CP.Y - PP.Y);
end;
function TAQSkinScrollBar.GetBoundsRect: TRect;
begin
if (Control <> nil) and (Control is TGraphicControl) and
(Control.Parent = nil) then
begin
Result := Rect(0, 0, 0, 0);
Exit;
end;
if FControl <> nil then
Result := Rect(FControl.Left, FControl.Top, FControl.Left + FControl.Width, FControl.Top + FControl.Height)
else
if FHandle <> 0 then
Windows.GetWindowRect(Handle, Result)
else
Result := Rect(0, 0, 0, 0);
end;
function TAQSkinScrollBar.GetEnabled: Boolean;
begin
if FControl <> nil then
Result := FControl.Enabled
else
Result := True;
end;
function TAQSkinScrollBar.GetHeight: Integer;
var
R: TRect;
begin
if (Control <> nil) and (Control is TGraphicControl) and
(Control.Parent = nil) then
begin
Result := 0;
Exit;
end;
if FControl <> nil then
Result := FControl.Height
else
if FHandle <> 0 then
begin
Windows.GetClientRect(Handle, R);
Result := R.Bottom;
end
else
Result := 0;
end;
function TAQSkinScrollBar.GetWidth: Integer;
var
R: TRect;
begin
if (Control <> nil) and (Control is TGraphicControl) and
(Control.Parent = nil) then
begin
Result := 0;
Exit;
end;
if FControl <> nil then
Result := FControl.Width
else
if FHandle <> 0 then
begin
Windows.GetClientRect(Handle, R);
Result := R.Right;
end
else
Result := 0;
end;
function TAQSkinScrollBar.HaveBorder: Boolean;
var
S, ExS: Cardinal;
begin
S := GetWindowLong(Handle, GWL_STYLE);
ExS := GetWindowLong(Handle, GWL_EXSTYLE);
if S and WS_BORDER = WS_BORDER then
Result := True
else
Result := False;
if ExS and WS_EX_CLIENTEDGE = WS_EX_CLIENTEDGE then
Result := True
else
Result := False;
end;
function TAQSkinScrollBar.HDownButtonRect: TRect;
begin
Result := HScrollRect;
if RectHeight(Result) > 0 then
begin
Result.Left := Result.Right - RectHeight(Result);
end
else
Result := Rect(0, 0, 0, 0);
end;
procedure TAQSkinScrollBar.HDrawScroll(DC: HDC);
var
// R: TRect;
Canvas: TCanvas;
// P: TPoint;
i: Integer;
// X, Y: Integer;
begin
if Handle = 0 then Exit;
if DC = 0 then Exit;
Canvas := TCanvas.Create;
Canvas.Handle := DC;
{ Fill back }
Canvas.Brush.Color := FBtnFace;
Canvas.FillRect(Rect(0, 0, Width, Height));
{ Draw Hscroll }
if RectHeight(HScrollRect) > 0 then
begin
FKind := sbHorizontal;
DrawButton(Canvas, CLIENT);
for i := 1 to BUTCOUNT - 1 do
DrawButton(Canvas, i);
if not HScrollDisabled then
DrawButton(Canvas, THUMB);
end;
Canvas.Handle := 0;
Canvas.Free;
end;
function TAQSkinScrollBar.HScrollDisabled: Boolean;
var
// P: TPoint;
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_HSCROLL), BarInfo);
if STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE then
Result := True
else
Result := False;
end;
function TAQSkinScrollBar.HScrollRect: TRect;
var
P: TPoint;
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_HSCROLL), BarInfo);
if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
Result := Rect(0, 0, 0, 0)
else
begin
P := BarInfo.rcScrollBar.TopLeft;
Windows.ScreenToClient(Handle, P);
Result.TopLeft := P;
P := BarInfo.rcScrollBar.BottomRight;
Windows.ScreenToClient(Handle, P);
Result.BottomRight := P;
with GetBorderTopLeft do
OffsetRect(Result, X, Y);
end;
end;
function TAQSkinScrollBar.HSliderRect: TRect;
var
Offset: Integer;
P: TPoint;
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_HSCROLL), BarInfo);
if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
Result := Rect(0, 0, 0, 0)
else
begin
P := BarInfo.rcScrollBar.TopLeft;
Windows.ScreenToClient(Handle, P);
Result.TopLeft := P;
P := BarInfo.rcScrollBar.BottomRight;
Windows.ScreenToClient(Handle, P);
Result.BottomRight := P;
with GetBorderTopLeft do
OffsetRect(Result, X, Y);
Offset := Result.Left;
Result.Left := Offset + BarInfo.xyThumbTop - 1;
Result.Right := Offset + BarInfo.xyThumbBottom - 1;
end;
end;
function TAQSkinScrollBar.HTrackRect: TRect;
begin
Result := HScrollRect;
if RectWidth(Result) > 0 then
begin
Result.Left := Result.Left + RectHeight(Result);
Result.Right := Result.Right - RectHeight(Result);
end
else
Result := Rect(0, 0, 0, 0);
end;
function TAQSkinScrollBar.HUpButtonRect: TRect;
begin
Result := HScrollRect;
if RectHeight(Result) > 0 then
begin
Result.Right := Result.Left + RectHeight(Result);
end
else
Result := Rect(0, 0, 0, 0);
end;
function TAQSkinScrollBar.IsPopupWindow: Boolean;
begin
Result := (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW) or
(GetWindowLong(Handle, GWL_STYLE) and WS_POPUP = WS_POPUP);
end;
procedure TAQSkinScrollBar.NewWindowProc(var Message: TMessage);
const
WM_VTChangeState = WM_APP + 32;
begin
case Message.Msg of
CM_BENCPAINT: CMBENCPaint(Message);
CM_SENCPAINT: CMSENCPaint(Message);
WM_LBUTTONDOWN: WMLButtonDown(TWMMouse(Message));
WM_LBUTTONUP: WMLButtonUp(TWMMouse(Message));
WM_NCLBUTTONDBLCLK: WMNCLButtonDblClk(TWMMouse(Message));
WM_NCLBUTTONDOWN: WMNCLButtonDown(TWMMouse(Message));
WM_NCMOUSEMOVE: WMNCMouseMove(TWMNCHitMessage(Message));
WM_NCLBUTTONUP: WMNCLButtonUp(TWMMouse(Message));
WM_MOUSEMOVE: WMMouseMove(TWMMouse(Message));
WM_NCPAINT: WMNCPaint(TWMNCPaint(Message));
WM_ERASEBKGND: WMEraseBkgnd(message);
WM_MOUSEWHEEL: WMMouseWheel(message);
WM_VSCROLL: WMVScroll(message);
WM_HSCROLL: WMHScroll(message);
WM_SIZE: WMSize(message);
WM_KEYDOWN: WMKeyDown(message);
WM_CAPTURECHANGED: WMCAPTURECHANGED(message);
WM_VTChangeState: WMVTChangeState(message);
CM_VISIBLECHANGED: CMVisibleChanged(message);
CM_MOUSEENTER: CMMouseEnter(message);
CM_MOUSELEAVE: CMMouseLeave(message);
EM_LINEINDEX: EMLINEINDEX(message);
WM_WINDOWPOSCHANGING: WMWindowPosChanging(TWMWindowPosChanged(Message));
WM_WINDOWPOSCHANGED: WMWindowPosChanged(TWMWindowPosChanged(Message));
WM_UNDO, WM_CUT, WM_PASTE, WM_CLEAR, EM_REPLACESEL: OnContextPopupAction(Message);
else
FOldWinProc(Message);
end;
end;
procedure TAQSkinScrollBar.OnContextPopupAction(var Message: TMessage);
begin
FOldWinProc(Message);
PaintScroll;
end;
procedure TAQSkinScrollBar.Paint(Canvas: TCanvas);
begin
end;
procedure TAQSkinScrollBar.PaintBorder(Canvas: TCanvas; R: TRect);
var //这些是叼毛
LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
SkinRect, ClRect: TRect;
LeftStretch, TopStretch, RightStretch, BottomStretch: Boolean;
var
// R1, R2: TRect;
Picture: TBitmap;
// SkinCtrl: TDataSkinMemoControl;
// FIndex: Integer;
NewClRect: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
LeftB, TopB, RightB, BottomB: TBitMap;
OffX, OffY: Integer;
// X, Y: Integer;
var
GripSize: Integer;
begin
LTPoint := Point(6, 5);
RTPoint := Point(52, 6);
LBPoint := Point(4, 46);
RBPoint := Point(53, 45);
SkinRect := rect(224, 347, 283, 399);
ClRect := rect(1, 1, 57, 51);
LeftStretch := False;
TopStretch := False;
RightStretch := False;
BottomStretch := False;
(*
LTPoint:=
RTPoint:=
LBPoint:=leftbottompoint=4,46
RBPoint:=rightbottompoint=53,45
skinrect=
clientrect=
leftstretch=0
topstretch=0
rightstretch=0
bottomstretch=0
*)
SkinRect := rect(0, 0, FBmp_Border.Width, FBmp_Border.Height);
Picture := FBmp_Border;
LeftB := TBitMap.Create;
TopB := TBitMap.Create;
RightB := TBitMap.Create;
BottomB := TBitMap.Create;
OffX := FControl.Width - RectWidth(SkinRect);
OffY := FControl.Height - RectHeight(SkinRect);
NewLTPoint := LTPoint;
NewRTPoint := Point(RTPoint.X + OffX, RTPoint.Y);
NewLBPoint := Point(LBPoint.X, LBPoint.Y + OffY);
NewRBPoint := Point(RBPoint.X + OffX, RBPoint.Y + OffY);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OffX, ClRect.Bottom + OffY);
CreateSkinBorderImages(LTPoint, RTPoint, LBPoint, RBPoint, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
LeftB, TopB, RightB, BottomB, Picture, SkinRect, Width, Height,
LeftStretch, TopStretch, RightStretch, BottomStretch);
Canvas.Draw(0, 0, TopB);
Canvas.Draw(0, TopB.Height, LeftB);
Canvas.Draw(FControl.Width - RightB.Width, TopB.Height, RightB);
Canvas.Draw(0, FControl.Height - BottomB.Height, BottomB);
TopB.Free;
LeftB.Free;
RightB.Free;
BottomB.Free;
//===============================
Canvas.Brush.Color := FBtnFace;
GripSize := GetSystemMetrics(SM_CXVSCROLL);
if Self.HaveBorder then
Canvas.FillRect(Rect(Width - GripSize - 2, Height - GripSize - 2, Width - 2, Height - 2))
else
Canvas.FillRect(Rect(Width - GripSize, Height - GripSize, Width, Height));
end;
procedure TAQSkinScrollBar.PaintScroll;
begin
{ Paint scrollbars }
if VScrollWnd <> nil then
begin
VScrollWnd.Invalidate;
end;
if HScrollWnd <> nil then
begin
HScrollWnd.Invalidate;
end;
end;
procedure TAQSkinScrollBar.SetControl(Value: TControl);
begin
if FControl <> nil then
begin
if @FOldWinProc <> nil then FControl.WindowProc := FOldWinProc;
end;
FControl := Value;
FOldWinProc := FControl.WindowProc;
FControl.WindowProc := NewWindowProc;
if (FControl is TWinControl) then
FHandle := TWinControl(FControl).Handle
else
FHandle := 0;
if VScrollWnd <> nil then FreeAndNil(VScrollWnd);
VScrollWnd := TWinScroll.CreateParented(Control.Parent.Handle);
VScrollWnd.DoubleBuffered := True;
TWinScroll(VScrollWnd).FSubclass := Self;
TWinScroll(VScrollWnd).FVertical := True;
with VScrollRect do
if IsPopupWindow
then
SetWindowPos(VScrollWnd.Handle, HWND_TOPMOST, Control.Left + Left, Control.Top + Top, Right - Left, Bottom - Top, SWP_NOREDRAW)
else
SetWindowPos(VScrollWnd.Handle, HWND_TOP, Control.Left + Left, Control.Top + Top, Right - Left, Bottom - Top, SWP_NOREDRAW);
if IsRectEmpty(VScrollRect) then
ShowWindow(VScrollWnd.Handle, SW_HIDE)
else
ShowWindow(VScrollWnd.Handle, SW_SHOW);
if HScrollWnd <> nil then FreeAndNil(HScrollWnd);
HScrollWnd := TWinScroll.CreateParented(Control.Parent.Handle);
HScrollWnd.DoubleBuffered := True;
TWinScroll(HScrollWnd).FSubclass := Self;
TWinScroll(HScrollWnd).FVertical := False;
with HScrollRect do
if IsPopupWindow
then
SetWindowPos(HScrollWnd.Handle, HWND_TOPMOST, Control.Left + Left, Control.Top + Top, Right - Left, Bottom - Top, SWP_NOREDRAW)
else
SetWindowPos(HScrollWnd.Handle, HWND_TOP, Control.Left + Left, Control.Top + Top, Right - Left, Bottom - Top, SWP_NOREDRAW);
if IsRectEmpty(HScrollRect) then
ShowWindow(HScrollWnd.Handle, SW_HIDE)
else
ShowWindow(HScrollWnd.Handle, SW_SHOW);
end;
procedure TAQSkinScrollBar.SetHandle(const Value: HWnd);
begin
end;
procedure TAQSkinScrollBar.UpdateScroll;
begin
{ Paint scrollbars }
if (VScrollWnd <> nil) and (VScrollWnd.HandleAllocated) then
begin
with VScrollRect do
if IsPopupWindow then
SetWindowPos(VScrollWnd.Handle, HWND_TOPMOST,
Control.Left + Left, Control.Top + Top,
Right - Left, Bottom - Top, SWP_SHOWWINDOW)
else
SetWindowPos(VScrollWnd.Handle, HWND_TOP,
Control.Left + Left, Control.Top + Top,
Right - Left, Bottom - Top, SWP_SHOWWINDOW);
end;
if (HScrollWnd <> nil) and (HScrollWnd.HandleAllocated) then
begin
with HScrollRect do
if IsPopupWindow then
SetWindowPos(HScrollWnd.Handle, HWND_TOPMOST,
Control.Left + Left, Control.Top + Top,
Right - Left, Bottom - Top, SWP_SHOWWINDOW)
else
SetWindowPos(HScrollWnd.Handle, HWND_TOP,
Control.Left + Left, Control.Top + Top,
Right - Left, Bottom - Top, SWP_SHOWWINDOW);
end;
PaintScroll;
end;
function TAQSkinScrollBar.VDownButtonRect: TRect;
begin
Result := VScrollRect;
if RectWidth(Result) > 0 then
begin
Result.Top := Result.Bottom - RectWidth(Result);
end
else
Result := Rect(0, 0, 0, 0);
end;
procedure TAQSkinScrollBar.VDrawScroll(DC: HDC);
var
// R: TRect;
Canvas: TCanvas;
// P: TPoint;
i: Integer;
// X, Y: Integer;
begin
if Handle = 0 then Exit;
if DC = 0 then Exit;
Canvas := TCanvas.Create;
if DC <> 0 then
Canvas.Handle := DC;
begin
{ Fill back }
Canvas.Brush.Color := FBtnFace;
Canvas.FillRect(Rect(0, 0, Width, Height));
{ Draw Vscroll }
if RectWidth(VScrollRect) > 0 then
begin
FKind := sbVertical;
DrawButton(Canvas, CLIENT);
for i := 1 to BUTCOUNT - 1 do
DrawButton(Canvas, i);
if not VScrollDisabled then
DrawButton(Canvas, THUMB);
end;
end;
Canvas.Handle := 0;
Canvas.Free;
end;
function TAQSkinScrollBar.VScrollDisabled: Boolean;
var
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_VSCROLL), BarInfo);
if STATE_SYSTEM_UNAVAILABLE and BarInfo.rgstate[0] = STATE_SYSTEM_UNAVAILABLE then
Result := True
else
Result := False;
end;
function TAQSkinScrollBar.VScrollRect: TRect;
var
P: TPoint;
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_VSCROLL), BarInfo);
if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
Result := Rect(0, 0, 0, 0)
else
begin
P := BarInfo.rcScrollBar.TopLeft;
Windows.ScreenToClient(Handle, P);
Result.TopLeft := P;
P := BarInfo.rcScrollBar.BottomRight;
Windows.ScreenToClient(Handle, P);
Result.BottomRight := P;
with GetBorderTopLeft do
OffsetRect(Result, X, Y);
end;
end;
function TAQSkinScrollBar.VSliderRect: TRect;
var
Offset: Integer;
P: TPoint;
BarInfo: TScrollBarInfo;
begin
BarInfo.cbSize := SizeOf(BarInfo);
GetScrollBarInfo(Handle, integer(OBJID_VSCROLL), BarInfo);
if STATE_SYSTEM_INVISIBLE and BarInfo.rgstate[0] <> 0 then
Result := Rect(0, 0, 0, 0)
else
begin
P := BarInfo.rcScrollBar.TopLeft;
Windows.ScreenToClient(Handle, P);
Result.TopLeft := P;
P := BarInfo.rcScrollBar.BottomRight;
Windows.ScreenToClient(Handle, P);
Result.BottomRight := P;
with GetBorderTopLeft do
OffsetRect(Result, X, Y);
Offset := Result.Top;
Result.Top := Offset + BarInfo.xyThumbTop - 1;
Result.Bottom := Offset + BarInfo.xyThumbBottom - 1;
end;
end;
function TAQSkinScrollBar.VTrackRect: TRect;
begin
Result := VScrollRect;
if RectWidth(Result) > 0 then
begin
Result.Top := Result.Top + RectWidth(Result);
Result.Bottom := Result.Bottom - RectWidth(Result);
end
else
Result := Rect(0, 0, 0, 0)
end;
function TAQSkinScrollBar.VUpButtonRect: TRect;
begin
Result := VScrollRect;
if RectWidth(Result) > 0 then
begin
Result.Bottom := Result.Top + RectWidth(Result);
end
else
Result := Rect(0, 0, 0, 0);
end;
procedure TAQSkinScrollBar.WMCAPTURECHANGED(var Msg: TMessage);
begin
if VUpState = bsasbPressed then
begin
VUpState := bsasbNormal;
PaintScroll;
end;
if VDownState = bsasbPressed then
begin
VDownState := bsasbNormal;
PaintScroll;
end;
if HUpState = bsasbPressed then
begin
HUpState := bsasbNormal;
PaintScroll;
end;
if HDownState = bsasbPressed then
begin
HDownState := bsasbNormal;
PaintScroll;
end;
FOldWinProc(TMessage(Msg));
Handled := True;
end;
procedure TAQSkinScrollBar.WMEraseBkgnd(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
if (Self.Control.ClassName = ‘TRichView‘) or
(Self.Control.ClassName = ‘TRichViewEdit‘)
then
PaintScroll;
end;
procedure TAQSkinScrollBar.WMHScroll(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMKeyDown(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
end;
procedure TAQSkinScrollBar.WMLButtonDown(var Msg: TWMMouse);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMLButtonUp(var Msg: TWMMouse);
begin
if VSliderState = bsasbPressed then
begin
ReleaseCapture;
lbtndown := False;
VSliderState := bsasbNormal;
PaintScroll;
Handled := True;
SendMessage(Handle, WM_VSCROLL, SB_ENDSCROLL, 0);
Exit;
end;
if HSliderState = bsasbPressed then
begin
ReleaseCapture;
lbtndown := False;
HSliderState := bsasbNormal;
PaintScroll;
Handled := True;
SendMessage(Handle, WM_HSCROLL, SB_ENDSCROLL, 0);
Exit;
end;
if VUpState = bsasbPressed then
begin
VUpState := bsasbNormal;
end;
if VDownState = bsasbPressed then
begin
VDownState := bsasbNormal;
end;
if HUpState = bsasbPressed then
begin
HUpState := bsasbNormal;
end;
if HDownState = bsasbPressed then
begin
HDownState := bsasbNormal;
end;
FOldWinProc(TMessage(Msg));
lbtndown := False;
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMMouseMove(var Msg: TWMMouse);
var
SF: TScrollInfo;
OldCurPos: single;
begin
if VSliderState = bsasbPressed then
begin
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_VERT, SF);
OldCurPos := FCurPos;
FCurPos := FCurPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.Y - FOldPos) / RectHeight(VTrackRect));
if FCurPos < SF.nMin then FCurPos := SF.nMin;
if FCurPos > SF.nMax then FCurPos := SF.nMax;
FOldPos := Mouse.CursorPos.Y;
SetScrollPos(Handle, SB_VERT, Round(FCurPos), False);
PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FCurPos))), 0);
PaintScroll;
Handled := True;
Exit;
end;
if HSliderState = bsasbPressed then
begin
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_HORZ, SF);
OldCurPos := FCurPos;
FCurPos := FCurPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.X - FOldPos) / RectWidth(HTrackRect));
if FCurPos < SF.nMin then FCurPos := SF.nMin;
if FCurPos > SF.nMax then FCurPos := SF.nMax;
FOldPos := Mouse.CursorPos.X;
if Control is TCustomListView then
begin
TCustomListView(FControl).Scroll(Round(FCurPos - OldCurPos), 0);
end
else
begin
SetScrollPos(Handle, SB_HORZ, Round(FCurPos), False);
PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FCurPos))), 0);
end;
PaintScroll;
Handled := True;
Exit;
end;
if (HSliderState <> bsasbPressed) and (HSliderState = bsasbHot) then
begin
HSliderState := bsasbNormal;
PaintScroll;
end;
if (VSliderState <> bsasbPressed) and (VSliderState = bsasbHot) then
begin
VSliderState := bsasbNormal;
PaintScroll;
end;
if (HUpState <> bsasbPressed) and (HUpState = bsasbHot) then
begin
HUpState := bsasbNormal;
PaintScroll;
end;
if (HDownState <> bsasbPressed) and (HDownState = bsasbHot) then
begin
HDownState := bsasbNormal;
PaintScroll;
end;
if (VUpState <> bsasbPressed) and (VUpState = bsasbHot) then
begin
VUpState := bsasbNormal;
PaintScroll;
end;
if (VDownState <> bsasbPressed) and (VDownState = bsasbHot) then
begin
VDownState := bsasbNormal;
PaintScroll;
end;
FOldWinProc(TMessage(Msg));
if lbtndown then
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMMouseWheel(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMNCLButtonDblClk(var Msg: TWMMouse);
begin
WMNCLButtonDown(Msg);
end;
procedure TAQSkinScrollBar.WMNCLButtonDown(var Msg: TWMMouse);
var
P: TPoint;
SF: TScrollInfo;
VEnabled, HEnabled: Boolean;
begin
P := Point(Msg.XPos, Msg.YPos);
ScreenToClient(Handle, P);
with GetBorderTopLeft do
begin
P.X := P.X + X;
P.Y := P.Y + Y;
end;
VEnabled := not VScrollDisabled;
HEnabled := not HScrollDisabled;
if PtInRect(VSliderRect, P) then
begin
lbtndown := True;
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_VERT, SF);
FCurPos := SF.nPos;
FOldPos := Mouse.CursorPos.Y;
VSliderState := bsasbPressed;
Handled := True;
PaintScroll;
SetCapture(Handle);
Exit;
end;
if PtInRect(HSliderRect, P) then
begin
lbtndown := True;
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_HORZ, SF);
FCurPos := SF.nPos;
FOldPos := Mouse.CursorPos.X;
HSliderState := bsasbPressed;
PaintScroll;
SetCapture(Handle);
Handled := True;
Exit;
end;
if PtInRect(VDownButtonRect, P) and VEnabled then
begin
VUpState := bsasbPressed;
end;
if PtInRect(VUpButtonRect, P) and VEnabled then
begin
VDownState := bsasbPressed;
end;
if PtInRect(HDownButtonRect, P) and HEnabled then
begin
HUpState := bsasbPressed;
end;
if PtInRect(HUpButtonRect, P) and HEnabled then
begin
HDownState := bsasbPressed;
end;
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMNCLButtonUp(var Msg: TWMMouse);
begin
if VSliderState = bsasbPressed then
begin
lbtndown := False;
VSliderState := bsasbNormal;
PaintScroll;
Handled := True;
Exit;
end;
if HSliderState = bsasbPressed then
begin
lbtndown := False;
HSliderState := bsasbNormal;
PaintScroll;
Handled := True;
Exit;
end;
if VUpState = bsasbPressed then
begin
VUpState := bsasbNormal;
end;
if VDownState = bsasbPressed then
begin
VDownState := bsasbNormal;
end;
if HUpState = bsasbPressed then
begin
HUpState := bsasbNormal;
end;
if HDownState = bsasbPressed then
begin
HDownState := bsasbNormal;
end;
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMNCMouseMove(var Msg: TWMNCHitMessage);
var
SF: TScrollInfo;
OldCurPos: single;
P: TPoint;
VEnabled, HEnabled: Boolean;
begin
P := Point(Msg.XCursor, Msg.YCursor);
ScreenToClient(Handle, P);
with GetBorderTopLeft do
begin
P.X := P.X + X;
P.Y := P.Y + Y;
end;
VEnabled := not VScrollDisabled;
HEnabled := not HScrollDisabled;
if VSliderState <> bsasbPressed then
begin
if PtInRect(VSliderRect, P) then
VSliderState := bsasbHot
else
VSliderState := bsasbNormal;
end;
if HSliderState <> bsasbPressed then
begin
if PtInRect(HSliderRect, P) then
HSliderState := bsasbHot
else
HSliderState := bsasbNormal;
end;
if (VUpState <> bsasbPressed) and VEnabled then
begin
if PtInRect(VDownButtonRect, P) then
VUpState := bsasbHot
else
VUpState := bsasbNormal;
end;
if (HUpState <> bsasbPressed) and HEnabled then
begin
if PtInRect(HDownButtonRect, P) then
HUpState := bsasbHot
else
HUpState := bsasbNormal;
end;
if (VDownState <> bsasbPressed) and VEnabled then
begin
if PtInRect(VUpButtonRect, P) then
VDownState := bsasbHot
else
VDownState := bsasbNormal;
end;
if (HDownState <> bsasbPressed) and HEnabled then
begin
if PtInRect(HUpButtonRect, P) then
HDownState := bsasbHot
else
HDownState := bsasbNormal;
end;
if VSliderState = bsasbPressed then
begin
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_VERT, SF);
OldCurPos := FCurPos;
FCurPos := FCurPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.Y - FOldPos) / RectHeight(VTrackRect));
if FCurPos < SF.nMin then FCurPos := SF.nMin;
if FCurPos > SF.nMax then FCurPos := SF.nMax;
FOldPos := Mouse.CursorPos.Y;
if Control is TCustomListView then
begin
TCustomListView(FControl).Scroll(0, Round((FCurPos - OldCurPos)));
end
else
begin
PostMessage(Handle, WM_VSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FCurPos))), 0);
end;
PaintScroll;
Handled := True;
Exit;
end;
if HSliderState = bsasbPressed then
begin
SF.fMask := SIF_ALL;
SF.cbSize := SizeOf(SF);
GetScrollInfo(Handle, SB_HORZ, SF);
OldCurPos := FCurPos;
FCurPos := FCurPos + (SF.nMax - SF.nMin) * ((Mouse.CursorPos.X - FOldPos) / RectWidth(HTrackRect));
if FCurPos < SF.nMin then FCurPos := SF.nMin;
if FCurPos > SF.nMax then FCurPos := SF.nMax;
FOldPos := Mouse.CursorPos.X;
if Control is TCustomListView then
begin
TCustomListView(FControl).Scroll(Round(FCurPos - OldCurPos), 0);
end
else
PostMessage(Handle, WM_HSCROLL, Integer(SmallPoint(SB_THUMBPOSITION, Round(FCurPos))), 0);
PaintScroll;
Handled := True;
Exit;
end;
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMNCPaint(var Msg: TWMNCPaint);
begin
FOldWinProc(TMessage(Msg));
DrawBorder(0, False);
Handled := True;
end;
procedure TAQSkinScrollBar.WMSize(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
UpdateScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMVScroll(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMVTChangeState(var Msg: TMessage);
begin
FOldWinProc(TMessage(Msg));
PaintScroll;
Handled := True;
end;
procedure TAQSkinScrollBar.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
begin
FOldWinProc(TMessage(Msg));
if Msg.WindowPos.Flags and SWP_HIDEWINDOW = SWP_HIDEWINDOW then
begin
if VScrollWnd <> nil then
ShowWindow(VScrollWnd.Handle, SW_HIDE);
if HScrollWnd <> nil then
ShowWindow(HScrollWnd.Handle, SW_HIDE);
end
else
if IsWindowVisible(Handle) then
begin
UpdateScroll;
DrawBorder(0, False);
end;
Handled := True;
end;
procedure TAQSkinScrollBar.WMWindowPosChanging(var Msg: TWMWindowPosChanged);
begin
if (Control is TScrollBox) and IsWindowVisible(Handle) then
begin
UpdateScroll;
end;
FOldWinProc(TMessage(Msg));
end;
end.
unit AQSkinScrollBar;
时间： 2024-09-29 20:31:20