strackbar.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sTrackBar;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls,
  commctrl, consts, sConst, acntUtils, sGraphUtils, ExtCtrls, sDefaults, sCommonData, {$IFNDEF DELPHI5}types,{$ENDIF}
  sFade{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type

  TsTrackBar = class;
{$IFNDEF NOTFORHELP}
  TAPoint = array of TPoint;
{$ENDIF}

  TsTrackBar = class(TTrackBar)
{$IFNDEF NOTFORHELP}
  private
    FDisabledKind: TsDisabledKind;
    FOnUserChange: TNotifyEvent;
    FCommonData: TsCommonData;

    FCanvas: TCanvas;
    FAnimatEvents: TacAnimatEvents;
    FadeTimer : TsFadeTimer;
    FShowFocus: boolean;
    procedure SetDisabledKind(const Value: TsDisabledKind);
    procedure SetShowFocus(const Value: boolean);
  protected
    AppShowHint : boolean;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;

    procedure WndProc (var Message: TMessage); override;
    procedure UserChanged;                 // by KJS
  public
    TickHeight : integer;
    iStep : real;
    Thumb : TBitmap;

    procedure PaintBody;
    procedure PaintBar; virtual;
    procedure PaintTicksHor;
    procedure PaintTicksVer;
    procedure PaintTick(P : TPoint; Horz : boolean);

    procedure PaintThumb(i: integer);
    function ThumbRect: TRect;
    function ChannelRect: TRect;
    function TickPos(i: integer): integer;
    function TickCount : integer;
    function TicksArray : TAPoint;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint;
    procedure PrepareCache;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    function Mode : integer;

//    function Margin: integer;
  published
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property ThumbLength default 23;
{$ENDIF} // NOTFORHELP
    property AnimatEvents : TacAnimatEvents read FAnimatEvents write FAnimatEvents default [aeGlobalDef];
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property ShowFocus : boolean read FShowFocus write SetShowFocus default False;
{$IFNDEF NOTFORHELP}
    property OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange; // KJS
{$ENDIF} // NOTFORHELP
  end;

implementation

uses sBorders, sStyleSimply, sMaskData, sSkinProps, sAlphaGraph, sVCLUtils,
  sMessages, math, sSkinManager;

//var
//  Co : integer = 0;

{ TsTrackBar }

constructor TsTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsTrackBar;

  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;

  Thumb := TBitmap.Create;
  Thumb.PixelFormat := pf24Bit;

//v4.66 ControlStyle := ControlStyle + [csOpaque] - [csDoubleClicks];

  TickHeight := 4;
  ThumbLength := 23;

  FDisabledKind := DefDisabledKind;
  FAnimatEvents := [aeGlobalDef];
end;

destructor TsTrackBar.Destroy;
begin
  StopFading(FadeTimer, FCommonData);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);

  if Assigned(Thumb) then FreeAndNil(Thumb);
  FCanvas.Free;
  inherited Destroy;
end;

procedure TsTrackBar.WndProc(var Message: TMessage);
var
  DC, SavedDC : hdc;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      RecreateWnd;
      exit
    end;
    AC_SETNEWSKIN, AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      Repaint;
      exit
    end;
    AC_PREPARECACHE : PrepareCache;
    AC_STOPFADING : begin StopFading(FadeTimer, FCommonData); Exit end;
    AC_DRAWANIMAGE : begin
      Message.Result := 0;
      if Message.LParam <> 0 then try
        DC := GetWindowDC(Handle);
        SavedDC := SaveDC(DC);
        try
          BitBlt(DC, 0, 0, Width, Height, TBitmap(Message.LParam).Canvas.Handle, 0, 0, SRCCOPY);
        finally
          RestoreDC(DC, SavedDC);
          ReleaseDC(Handle, DC);
        end;
      finally
        Message.Result := 1;
      end;
      Exit;
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
      FCommonData.Updating := False;
      Repaint;
    end
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned(True) then inherited else begin
    case Message.Msg of
      WM_PRINT : begin
        PaintWindow(TWMPaint(Message).DC);
      end;
      WM_PAINT : begin
        ControlState := ControlState + [csCustomPaint];
      end;
      WM_ERASEBKGND : Exit;
      WM_SETFOCUS, CM_ENTER : if not (csDesigning in ComponentState) then begin
        inherited;
        if Enabled then begin
          if FadeTimer = nil then Repaint else FadeTimer.Change; // Fast repaint
        end;
        Exit;
      end;
      WM_KILLFOCUS, CM_EXIT: if not (csDesigning in ComponentState) then begin
        inherited;
        if Enabled then begin
          if FadeTimer <> nil then StopFading(FadeTimer, FCommonData);
          Exit
        end;
      end;
      WM_LBUTTONUP : if not (csDesigning in ComponentState) and Enabled then begin
        Application.ShowHint := AppShowHint;
        ShowHintStored := False;
        if PtInRect(ThumbRect, SmallPointToPoint(TWMMouse(Message).Pos)) then begin
          ControlState := ControlState - [csLButtonDown];
          DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents), fdUp);
        end
        else if FadeTimer <> nil then StopFading(FadeTimer, FCommonData);
      end;
      WM_LBUTTONDBLCLK, WM_LBUTTONDOWN : if not (csDesigning in ComponentState) and Enabled then begin
        if not ShowHintStored then begin
          AppShowHint := Application.ShowHint;
          Application.ShowHint := False;
          ShowHintStored := True;
        end;
        if PtInRect(ThumbRect, SmallPointToPoint(TWMMouse(Message).Pos)) then begin
          ControlState := ControlState + [csLButtonDown];
          DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseDown, FAnimatEvents));
        end
        else if FadeTimer <> nil then StopFading(FadeTimer, FCommonData);
      end;
      CN_HSCROLL, CN_VSCROLL : {if not PtInRect(ThumbRect, ScreenToClient(Mouse.CursorPos)) and (FadeTimer <> nil) then} begin
        StopFading(FadeTimer, FCommonData);
        Repaint;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    case Message.Msg of
      WM_MOVE : if csDesigning in ComponentState then Repaint;
      WM_PAINT : ControlState := ControlState - [csCustomPaint];
      CM_MOUSEENTER : if not (csDesigning in ComponentState) and not (csLButtonDown in ControlState) then begin
        FCommonData.FMouseAbove := True;
        DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseEnter, FAnimatEvents));
      end;
      CM_MOUSELEAVE : if not (csDesigning in ComponentState) and not (csLButtonDown in ControlState) then begin
        FCommonData.FMouseAbove := False;
        DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseLeave, FAnimatEvents));
      end;
    end;
  end;
  case Message.Msg of
    CN_HSCROLL, CN_VSCROLL : UserChanged;
  end;
end;

procedure TsTrackBar.PaintBody;
var
  R : TRect;
begin
  R := ClientRect;
  PaintItem(FCommonData, GetParentCache(FCommonData), True, integer(ControlIsActive(FCommonData)),
    R, Point(Left, Top), FCommonData.FCacheBmp, False);
  if FShowFocus and (Focused or (csLButtonDown in ControlState)) then begin
    InflateRect(R, -1, -1);
    FocusRect(FCommonData.FCacheBMP.Canvas, R);
  end;
  PaintBar;
  PaintThumb(Position);
end;

procedure TsTrackBar.PaintBar;
var
  w, h, i : integer;
  aRect : TRect;
  CI : TCacheInfo;
begin
  aRect := ChannelRect;
  i := SkinData.SkinManager.GetMaskIndex(FCommonData.SkinIndex, FCommonData.SkinSection, s_SliderChannelMask);
  if SkinData.SkinManager.IsValidImgIndex(i) then begin
    case Orientation of
      trHorizontal: begin
        h := SkinData.SkinManager.MaskSize(i).cy - 1 {v5.05};
        w := HeightOf(aRect);
        aRect.Top := aRect.Top + (w - h) div 2;
        aRect.Bottom := aRect.Top + h;
      end;
      trVertical: begin
        h := SkinData.SkinManager.MaskSize(i).cx - 1 {v5.05};
        w := WidthOf(aRect);
        aRect.Left := aRect.Left + (w - h) div 2;
        aRect.Right := aRect.Left + h;
      end;
    end;
{    if (SkinData.FOwnerControl <> nil) and (SkinData.FOwnerControl.Parent <> nil) then begin
      CtrlParentColor := ColorToRGB(TsHackedControl(SkinData.FOwnerControl.Parent).Color);
    end;}
    CI := MakeCacheInfo(FCommonData.FCacheBmp);
    DrawSkinRect(FCommonData.FCacheBmp, aRect, True, CI, SkinData.SkinManager.ma[i], integer(ControlIsActive(FCommonData)), True);
  end;
  if Orientation = trHorizontal then PaintTicksHor else PaintTicksVer;
end;

procedure TsTrackBar.PaintTicksHor;
var
  i, mh : integer;
  pa : TAPoint;
  cr : TRect;
begin
  pa := nil;
  if TickStyle <> tsNone then begin
    pa := TicksArray;