⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 suitrackbar.pas

📁 新颖按钮控件
💻 PAS
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUITrackBar.pas
//  Creator     :   Shen Min
//  Date        :   2002-11-20
//  Comment     :
//
//  Copyright (c) 2002-2003 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUITrackBar;

interface

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

type
    TsuiTrackBar = class(TCustomPanel)
    private
        m_BarImage : TPicture;
        m_Slider : TsuiImagePanel;
        m_Min : Integer;
        m_Max : Integer;
        m_Position : Integer;
        m_Orientation : TsuiProgressBarOrientation;
        m_UIStyle : TsuiUIStyle;
        m_OnChange : TNotifyEvent;

        m_bSlidingFlag : Boolean;
        m_MouseDownPos : 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);

        procedure UpdateControl();
        procedure UpdateSlider();
        procedure UpdatePicture();
        function GetSliderPosFromPosition() : TPoint;
        function GetPositionFromFromSliderPos(X, Y : Integer) : Integer;
        procedure UpdatePositionValue(X, Y : Integer; Update : Boolean);

        procedure OnSliderMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
        procedure SetSize();

        procedure WMERASEBKGND(var Msg : TMessage); message WM_ERASEBKGND;

    protected
        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;

    public
        m_BarImageBuf : TBitmap;

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

    published
        property Orientation : TsuiProgressBarOrientation read m_Orientation write SetOrientation;
        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 Align;
        property Alignment;
        property BiDiMode;        
        property Anchors;
        property Color;
        property DragKind;
        property DragMode;
        property Enabled;
        property ParentBiDiMode;
        property ParentFont;
        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;

implementation

uses SUIPublic;

{ TsuiTrackBar }

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

    m_BarImageBuf := TBitmap.Create();

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

    m_Min := 0;
    m_Max := 100;
    Position := 0;
    m_Orientation := suiHorizontal;

    m_bSlidingFlag := false;

    UIStyle := GetSUIFormStyle(TCustomForm(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;
        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;
        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;
begin
    Buf := TBitmap.Create();
    Buf.Width := Width;
    Buf.Height := Height;

    Buf.Canvas.Brush.Color := Color;
    Buf.Canvas.FillRect(Rect(0, 0, Buf.Width, Buf.Height));

    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;

    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
    m_Max := Value;

    UpdateSlider();
end;

procedure TsuiTrackBar.SetMin(const Value: Integer);
begin
    m_Min := Value;

    UpdateSlider();
end;

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

    UpdateControl();
end;

procedure TsuiTrackBar.SetPosition(const Value: Integer);
begin
    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
    if m_UIStyle = Value then
        Exit;
    m_UIStyle := Value;

    if m_UIStyle = Custom then
        Exit;

    Color := GetThemeColor(m_UIStyle, SUI_TRACKBAR_BGCOLOR);
    UpdateControl();
end;

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

procedure TsuiTrackBar.Resize;
begin
    inherited;

    UpdateControl();
end;

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

    if not m_bSlidingFlag then
        Exit;

    if m_Orientation = suiHorizontal then
    begin
        nPos := X - m_MouseDownPos;
        if nPos < 0 then
            nPos := 0
        else if nPos > Width - m_Slider.Width then
            nPos := Width - m_Slider.Width;
        m_Slider.Left := nPos;
    end
    else
    begin
        nPos := Y - m_MouseDownPos;
        if nPos < 0 then
            nPos := 0
        else if nPos > Height - m_Slider.Height then
            nPos := Height - m_Slider.Height;
        m_Slider.Top := nPos;
    end;

    if Assigned(m_OnChange) then
        m_OnChange(self);

    UpdatePositionValue(X, Y, false);
end;

procedure TsuiTrackBar.OnSliderMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if m_Orientation = suiHorizontal then
        m_MouseDownPos := X
    else
        m_MouseDownPos := Y;
    m_bSlidingFlag := true;

    SetCapture(Handle);
end;

procedure TsuiTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
    inherited;

    UpdatePositionValue(X, Y, True);
end;

procedure TsuiTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
    inherited;

    m_bSlidingFlag := false;
    ReleaseCapture();
end;

function TsuiTrackBar.GetPositionFromFromSliderPos(X, Y: Integer): Integer;
begin
    if m_Orientation = suiHorizontal then
        Result := (X - m_Slider.Width div 2) * (m_Max - m_Min) div (Width - m_Slider.Width) + m_Min
    else
        Result := (Y - m_Slider.Height div 2) * (m_Max - m_Min) div (Height - m_Slider.Height) + m_Min;
end;

procedure TsuiTrackBar.SetSize();
begin
    if m_Orientation = suiHorizontal then
        Height := Math.Max(m_BarImage.Height, m_Slider.Height)
    else
        Width := Math.Max(m_BarImage.Height, m_Slider.Width);

    Repaint();
end;

procedure TsuiTrackBar.WMERASEBKGND(var Msg: TMessage);
begin
    // do nothing
end;

procedure TsuiTrackBar.UpdatePicture;
var
    R : TRect;
begin
    if m_UIStyle = Custom then
    begin
        m_BarImageBuf.Width := m_BarImage.Width;
        m_BarImageBuf.Height := m_BarImage.Height;
        m_BarImageBuf.Canvas.Draw(0, 0, m_BarImage.Graphic);
        if m_Orientation = suiVertical then
            RoundPicture(m_BarImageBuf);
        Exit;
    end;

    if m_Orientation = suiHorizontal then
    begin
        m_BarImage.Bitmap.LoadFromResourceName(
            hInstance,
            GetThemeString(m_UIStyle, SUI_TRACKBAR_BAR)
        );
        m_BarImageBuf.Width := Width;
        m_BarImageBuf.Height := m_BarImage.Height;
        R := Rect(0, 0, m_BarImageBuf.Width, m_BarImageBuf.Height);
        SpitDrawHorizontal(m_BarImage.Bitmap, m_BarImageBuf.Canvas, R, false);
        SliderImage.Bitmap.LoadFromResourceName(
            hInstance,
            GetThemeString(m_UIStyle, SUI_TRACKBAR_SLIDER)
        )
    end
    else
    begin
        m_BarImage.Bitmap.LoadFromResourceName(
            hInstance,
            GetThemeString(m_UIStyle, SUI_TRACKBAR_BAR_V)
        );
        m_BarImageBuf.Width := Height;
        m_BarImageBuf.Height := m_BarImage.Height;
        R := Rect(0, 0, m_BarImageBuf.Width, m_BarImageBuf.Height);
        SpitDrawHorizontal(m_BarImage.Bitmap, m_BarImageBuf.Canvas, R, false);
        RoundPicture(m_BarImageBuf);
        SliderImage.Bitmap.LoadFromResourceName(
            hInstance,
            GetThemeString(m_UIStyle, SUI_TRACKBAR_SLIDER_V)
        );
    end;

    m_Slider.AutoSize := true;
end;

procedure TsuiTrackBar.UpdateControl;
begin
    UpdateSlider();
    UpdatePicture();
    SetSize();
    Repaint();
end;

procedure TsuiTrackBar.UpdatePositionValue(X, Y : Integer; Update : Boolean);
var
    nPos : Integer;
begin
    nPos := GetPositionFromFromSliderPos(X, Y);
    if nPos > m_Max then
        nPos := m_Max
    else if nPos < 0 then
        nPos := 0;
    if Update then
        Position := nPos
    else
        m_Position := nPos;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -