标签：size windows $0 des _id hot roc app tcl
再说：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.
标签：size windows $0 des _id hot roc app tcl
原文地址：http://www.cnblogs.com/rogge7/p/6178740.html
