📄 suitrackbar.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 + -