suitrackbar.pas

SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件

////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUITrackBar.pas
//  Creator     :   Shen Min
//  Date        :   2002-11-20 V1-V3
//                  2003-06-30 V4
//                  2006-06-14 V6
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: [e-mail]
//
////////////////////////////////////////////////////////////////////////////////

unit SUITrackBar;

interface

{$I SUIPack.inc}

uses Windows, Messages, SysUtils, Classes, Controls, Graphics, ExtCtrls, Forms,
     Math,
     SUIImagePanel, SUIThemes, SUIProgressBar, SUIMgr, SUI2Define;

type
    TsuiTrackBar = class(TCustomPanel)
    private
        m_BarImage : TPicture;
        m_Timer : TTimer;
        m_Slider : TsuiImagePanel;
        m_Min : Integer;
        m_Max : Integer;
        m_Position : Integer;
        m_LastPos : Integer;
        m_Orientation : TsuiProgressBarOrientation;
        m_FileTheme : TsuiFileTheme;        
        m_UIStyle : TsuiUIStyle;
        m_ShowTick : Boolean;
        m_Transparent : Boolean;
        m_OnChange : TNotifyEvent;
        m_CustomPicture : Boolean;
        m_LastChange : Integer;

        m_bSlidingFlag : Boolean;
        m_MouseDownPos : Integer;
        m_Frequency : Integer;

        procedure SetBarImage(const Value: TPicture);
        procedure SetMax(const Value: Integer);
        procedure SetMin(const Value: Integer);
        procedure SetPosition(const Value: Integer);
        procedure SetUIStyle(const Value: TsuiUIStyle);
        procedure SetOrientation(const Value: TsuiProgressBarOrientation);
        function GetSliderImage: TPicture;
        procedure SetSliderImage(const Value: TPicture); virtual;
        procedure SetTransparent(const Value: Boolean);

        procedure UpdateControl();
        procedure UpdateSlider();
        function GetSliderPosFromPosition() : TPoint;
        function GetPositionFromFromSliderPos(X, Y : Integer) : Integer;
        procedure UpdatePositionValue(X, Y : Integer; Update : Boolean);
        procedure SetPageSize(const Value: Integer);
        procedure SetLineSize(const Value: Integer);
        procedure SetShowTick(const Value: Boolean);
        procedure SetFileTheme(const Value: TsuiFileTheme);
        procedure SetFrequency(const Value: Integer);

        procedure OnSliderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure OnSliderMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure OnTimer(Sender : TObject);
        procedure SetSize();
        procedure PaintTick(const Buf : TBitmap);

        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;
        procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
        procedure CMFocusChanged(var Msg: TCMFocusChanged); message CM_FOCUSCHANGED;

    protected
        m_PageSize : Integer;
        m_LineSize : Integer;

        procedure UpdatePicture(); virtual;
        function CustomPicture() : Boolean; virtual;
        function SUICanFocus() : Boolean; virtual;
        procedure Paint(); override;
        procedure Resize(); override;
        procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
        procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
        procedure KeyDown(var Key: word; Shift: TShiftState); override;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;

        function SliderTransparent() : boolean; virtual;

        property LastChange : Integer read m_LastChange;

    public
        m_BarImageBuf : TBitmap;

        constructor Create(AOwner : TComponent); override;
        destructor Destroy(); override;

        property UseCustomPicture : Boolean read m_CustomPicture write m_CustomPicture;

    published
        property Orientation : TsuiProgressBarOrientation read m_Orientation write SetOrientation;
        property FileTheme : TsuiFileTheme read m_FileTheme write SetFileTheme;
        property UIStyle : TsuiUIStyle read m_UIStyle write SetUIStyle;
        property BarImage : TPicture read m_BarImage write SetBarImage;
        property SliderImage : TPicture read GetSliderImage write SetSliderImage;
        property Max : Integer read m_Max write SetMax;
        property Min : Integer read m_Min write SetMin;
        property Position : Integer read m_Position write SetPosition;
        property PageSize : Integer read m_PageSize write SetPageSize;
        property LineSize : Integer read m_LineSize write SetLineSize;
        property ShowTick : Boolean read m_ShowTick write SetShowTick;
        property Transparent : Boolean read m_Transparent write SetTransparent;
        property Frequency : Integer read m_Frequency write SetFrequency;

        property Align;
        property Alignment;
        property BiDiMode;
        property Anchors;
        property Color;
        property DragKind;
        property DragMode;
        property Enabled;
        property ParentBiDiMode;
        property ParentFont;
        property ParentColor;
        property ParentShowHint;
        property ShowHint;
        property TabOrder;
        property TabStop;
        property Visible;

        property OnChange : TNotifyEvent read m_OnChange write m_OnChange;
        property OnCanResize;
        property OnClick;
        property OnContextPopup;
        property OnDockDrop;
        property OnDockOver;
        property OnDblClick;
        property OnDragDrop;
        property OnDragOver;
        property OnEndDock;
        property OnEndDrag;
        property OnEnter;
        property OnExit;
        property OnMouseDown;
        property OnMouseMove;
        property OnMouseUp;
        property OnResize;
        property OnStartDock;
        property OnStartDrag;
        property OnUnDock;
    end;

    TsuiScrollTrackBar = class(TsuiTrackBar)
    private
        function GetSliderVisible: Boolean;
        procedure SetSliderVisible(const Value: Boolean);

    protected
        function SliderTransparent() : boolean; override;
        function CustomPicture() : Boolean; override;
        function SUICanFocus() : Boolean; override;
        
    public
        constructor Create(AOwner : TComponent); override;
        procedure UpdateSliderSize();
        property SliderVisible : Boolean read GetSliderVisible write SetSliderVisible;
        property LastChange;
    end;

implementation

uses SUIPublic;

{ TsuiTrackBar }

constructor TsuiTrackBar.Create(AOwner: TComponent);
begin
    inherited;

    ControlStyle := ControlStyle - [csAcceptsControls];
    m_BarImageBuf := TBitmap.Create();

    m_BarImage := TPicture.Create();
    
    m_Slider := TsuiImagePanel.Create(self);
    m_Slider.Parent := self;
    m_Slider.OnMouseDown := OnSliderMouseDown;
    m_Slider.OnMouseUp := OnSliderMouseUp;

    m_Timer := nil;

    Min := 0;
    Max := 10;
    Position := 0;
    m_LastPos := 0;
    Orientation := suiHorizontal;
    PageSize := 2;
    LineSize := 1;
    m_ShowTick := true;
    ParentColor := true;

    m_bSlidingFlag := false;
    TabStop := true;
    m_CustomPicture := false;
    m_Frequency := 1;
    m_LastChange := 0;

    UIStyle := GetSUIFormStyle(AOwner);
    UpdateSlider();
end;

destructor TsuiTrackBar.Destroy;
begin
    m_Slider.Free();
    m_Slider := nil;

    m_BarImage.Free();
    m_BarImage := nil;

    m_BarImageBuf.Free();
    m_BarImageBuf := nil;

    inherited;
end;

function TsuiTrackBar.GetSliderPosFromPosition: TPoint;
var
    nY : Integer;
begin
    if m_Orientation = suiHorizontal then
    begin
        nY := Height - m_Slider.Height;
        if nY < 0 then
            nY := 0;
        Result.Y := nY div 2;
        if m_Max = m_Min then
            Result.X := 0
        else
            Result.X := ((m_Position - m_Min) * (Width - m_Slider.Width)) div (m_Max - m_Min);
    end
    else
    begin
        nY := Width - m_Slider.Width;
        if nY < 0 then
            nY := 0;
        Result.X := nY div 2;
        if m_Max = m_Min then
            Result.Y := 0
        else
            Result.Y := ((m_Position - m_Min) * (Height - m_Slider.Height)) div (m_Max - m_Min);
    end;
end;

function TsuiTrackBar.GetSliderImage: TPicture;
begin
    Result := m_Slider.Picture;
end;

procedure TsuiTrackBar.Paint;
var
    Buf : TBitmap;
    nTop : Integer;
    R : TRect;
begin
    Buf := TBitmap.Create();
    Buf.Width := Width;
    Buf.Height := Height;

    if m_Transparent then
    begin
        DoTrans(Buf.Canvas, self);
    end
    else
    begin
        Buf.Canvas.Brush.Color := Color;
        Buf.Canvas.FillRect(Rect(0, 0, Buf.Width, Buf.Height));
    end;

    if m_Orientation = suiHorizontal then
    begin
        nTop := (Height - m_BarImage.Height) div 2;
        BitBlt(
            Buf.Canvas.Handle,
            0,
            nTop,
            Buf.Width,
            nTop + m_BarImage.Height,
            m_BarImageBuf.Canvas.Handle,
            0,
            0,
            SRCCOPY
        );
    end
    else
    begin
        nTop := (Width - m_BarImage.Height) div 2;
        BitBlt(
            Buf.Canvas.Handle,
            nTop,
            0,
            nTop + m_BarImage.Width,
            Height,
            m_BarImageBuf.Canvas.Handle,
            0,
            0,
            SRCCOPY
        );
    end;

    if Focused and TabStop then
    begin
        R := Rect(0, 0, Width, Height);
        Buf.Canvas.Brush.Style := bsSolid;
        Buf.Canvas.DrawFocusRect(R);
    end;
    if m_ShowTick then
        PaintTick(Buf);
    Canvas.Draw(0, 0, Buf);

    Buf.Free();
end;

procedure TsuiTrackBar.SetBarImage(const Value: TPicture);
begin
    m_BarImage.Assign(Value);

    UpdateControl();
end;

procedure TsuiTrackBar.SetMax(const Value: Integer);
begin
    if m_Max = Value then
        Exit;
    m_Max := Value;
    if m_Max < m_Min then
        m_Max := m_Min;
    if m_Max < m_Position then
        m_Position := m_Max;
    UpdateSlider();
end;

procedure TsuiTrackBar.SetMin(const Value: Integer);
begin
    if m_Min = Value then
        Exit;
    m_Min := Value;
    if m_Min > m_Max then
        m_Min := m_Max;
    if m_Min > m_Position then
        m_Position := m_Min;
    UpdateSlider();
end;

procedure TsuiTrackBar.SetOrientation(const Value: TsuiProgressBarOrientation);
begin
    if m_Orientation = Value then
        Exit;

    m_Orientation := Value;
    UpdateControl();
end;

procedure TsuiTrackBar.SetPosition(const Value: Integer);
begin
    if Value < m_Min then
        m_Position := m_Min
    else if Value > m_Max then
        m_Position := m_Max
    else
        m_Position := Value;

    UpdateSlider();
end;

procedure TsuiTrackBar.SetSliderImage(const Value: TPicture);
begin
    m_Slider.Picture.Assign(Value);
    Repaint();
end;

procedure TsuiTrackBar.SetUIStyle(const Value: TsuiUIStyle);
begin
    m_UIStyle := Value;

    UpdateControl();
{$IFDEF RES_MACOS}
    if m_UIStyle = MacOS then
        Transparent := true;
{$ENDIF}
end;

procedure TsuiTrackBar.UpdateSlider;
var
    SliderPos : TPoint;
begin
    SliderPos := GetSliderPosFromPosition();
    PlaceControl(m_Slider, SliderPos);
    Repaint();
    if m_Position <> m_LastPos then
    begin
        m_LastChange := m_Position - m_LastPos;
        m_LastPos := m_Position;
        if Assigned(m_OnChange) then
            m_OnChange(self);
    end;
end;

procedure TsuiTrackBar.Resize;
begin
    inherited;

    UpdateControl();
end;

procedure TsuiTrackBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
    inherited;

    if not m_bSlidingFlag then
    begin
        if (X < 0) or (X > Width) or (Y < 0) or (Y > Height) then
            if m_Timer <> nil then
            begin
                m_Timer.Free();