5,386
社区成员
发帖
与我相关
我的任务
分享
unit MyTrackBar;
interface
uses
System.SysUtils, System.Classes, Vcl.Controls,Winapi.Messages,Winapi.Windows,
Winapi.GDIPAPI,Winapi.GDIPOBJ,Winapi.GDIPUTIL,Vcl.Consts,Vcl.ComCtrls,Graphics;
type
TMyTrackBar = class(TGraphicControl)
private
{ Private declarations }
FText:string;
FCaption:string;
FDown:Boolean;
Fposition:Integer;
FMax:Integer;
FMin:Integer;
FDoubleBuffered:Boolean;
FTransparentSet: Boolean;
FOnChange: TNotifyEvent;
procedure SetFposition(Value:integer);
procedure SetFText(Value:string);
procedure SetFCaption(Value:string);
procedure SetFMax(Value:integer);
procedure SetFMin(Value:integer);
function GetTransparent: Boolean;
procedure SetTransparent(Value: Boolean);
procedure SetParam(APosition,AMin,AMax:integer);
procedure SetDoubleBuffered(Value:Boolean);
function IsDoubleBufferedStored: Boolean;
protected
{ Protected declarations }
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Position:Integer read Fposition write SetFposition default 0;
property Max:Integer read FMax write SetFMax default 10;
property Min:Integer read FMin write SetFMin default 0;
property Transparent: Boolean read GetTransparent write SetTransparent stored FTransparentSet;
property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered stored IsDoubleBufferedStored;
property Text:string read FText write SetFText;
property Caption:string read FCaption write SetFCaption;
property visible;
property font;
property OnContextPopup;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnGesture;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TMyTrackBar]);
end;
{ TMyTrackBar }
var
R:TRect;
path3,Path1,Path2: TGPGraphicsPath;
g:TGPGraphics;
p: TGPPen;
b:TGPSolidBrush;
Br: TGPLinearGradientBrush;
BT: TGPPathGradientBrush;
Factors: array[0..2] of Single;
Positions: array[0..2] of Single;
const
MaxAutoTicks = 10000;
// NomalLength =200;
constructor TMyTrackBar.Create(AOwner: TComponent);
begin
inherited;
Width:=203;
Height:=50;
end;
destructor TMyTrackBar.Destroy;
begin
inherited;
end;
function TMyTrackBar.GetTransparent: Boolean;
begin
Result := not (csOpaque in ControlStyle);
end;
function TMyTrackBar.IsDoubleBufferedStored: Boolean;
begin
Result := True;
end;
procedure TMyTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
if Button=mbLeft then
begin
if path3.IsVisible(x,y) then
begin
FDown:=True;
FPosition:=X-ClientRect.Left-5;
//Invalidate;
Repaint;
end;
end;
end;
procedure TMyTrackBar.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
// inherited;
if FDown=True then
begin
if X<ClientRect.Left+6 then Exit;
if X>ClientRect.Width-5 then Exit;
Fposition:=X-ClientRect.Left-5;
//Invalidate;
Repaint;
end;
end;
procedure TMyTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
if Button=mbLeft then
begin
FDown:=False;
//Invalidate;
end;
end;
procedure TMyTrackBar.Paint;
var
num:Integer;
ColorArr:TGPColor;
begin
inherited;
Factors[0]:=0.0;
Factors[1]:=0.5;
Factors[2]:=1.0;
Positions[0]:=0.0;
Positions[1]:=0.2;
Positions[2]:=1.0;
SetRect(R,Fposition,ClientRect.Height div 2 -5,Fposition+10,ClientRect.Height div 2 +5);
g := TGPGraphics.Create(Canvas.Handle);
try
p:= TGPPen.Create(aclSilver, 1);
Path1 := TGPGraphicsPath.Create;
Path1.AddEllipse(MakeRect(R));
Path2:= TGPGraphicsPath.Create;
Path2.AddRectangle(MakeRect(ClientRect.Left+2,ClientRect.Height div 2 -1,Fposition,3));
path3:=TGPGraphicsPath.Create;
path3.AddRectangle(MakeRect(ClientRect.Left+1,ClientRect.Height div 2 -2,ClientRect.Width-2,4));
b:=TGPSolidBrush.Create(aclWhite);
br:=TGPLinearGradientBrush.Create(MakeRect(ClientRect.Left+1,ClientRect.Height div 2 -1,Fposition,3),aclSkyBlue, aclwhite,LinearGradientModeHorizontal);
br.SetBlend(@factors,@positions,3);
bt:=TGPPathGradientBrush.Create(Path1);
if FDown then
begin
ColorArr:=aclSkyBlue;
bt.SetCenterColor(aclWhite);
num:=1;
bt.SetSurroundColors(PARGB(@ColorArr),num);
end
else
begin
ColorArr:=aclWhite;
bt.SetCenterColor(aclSkyBlue);
num:=1;
bt.SetSurroundColors(PARGB(@ColorArr),num);
end;
g.DrawPath(p,path3);
g.DrawPath(p,path1);
g.fillpath(bt,path1);
g.FillPath(br,Path2);
Canvas.Brush.Style:=bsClear;
Canvas.Font:=font;
Canvas.TextOut(0,0,Caption);
Canvas.TextOut(0,ClientRect.Height div 2 +8,Text);
finally
BT.Free;
Br.Free;
p.Free;
g.Free;
end;
end;
procedure TMyTrackBar.SetFCaption(Value: string);
begin
FCaption:=Value;
Invalidate;
end;
procedure TMyTrackBar.SetDoubleBuffered(Value: Boolean);
begin
if Value <> FDoubleBuffered then
begin
FDoubleBuffered := Value;
// FParentDoubleBuffered := False;
Perform(CM_DOUBLEBUFFEREDCHANGED, 0, 0);
end;
end;
procedure TMyTrackBar.SetFMax(Value: Integer);
begin
if Value >= FMin then
SetParam(FPosition, FMin, Value);
//Invalidate;
end;
procedure TMyTrackBar.SetFMin(Value: integer);
begin
if Value <= FMax then
SetParam(FPosition, Value, FMax);
//Invalidate;
end;
procedure TMyTrackBar.SetFposition(Value: integer);
begin
SetParam(Value, FMin, FMax);
Invalidate;
end;
procedure TMyTrackBar.SetFText(Value: string);
begin
FText:=Value;
Invalidate;
end;
procedure TMyTrackBar.SetParam(APosition, AMin, AMax: integer);
begin
if AMax < AMin then
raise EInvalidOperation.CreateFmt(SPropertyOutOfRange, [Self.Classname]);
if APosition < AMin then APosition := AMin;
if APosition > AMax then APosition := AMax;
if (AMax - AMin > MaxAutoTicks) <> (FMax - FMin > MaxAutoTicks) then
begin
FMin := AMin;
FMax := AMax;
end;
if (FMin <> AMin) then
begin
FMin := AMin;
// if HandleAllocated then
// SendMessage(Handle, TBM_SETRANGEMIN, 1, AMin);
end;
if (FMax <> AMax) then
begin
FMax := AMax;
// if HandleAllocated then
// SendMessage(Handle, TBM_SETRANGEMAX, 1, AMax);
end;
if FPosition <> APosition then
begin
FPosition := APosition;
// if HandleAllocated then
// SendMessage(Handle, TBM_SETPOS, 1, APosition);
// Changed;
end;
end;
procedure TMyTrackBar.SetTransparent(Value: Boolean);
begin
if Transparent <> Value then
begin
if Value then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];
Invalidate;
end;
FTransparentSet := True;
end;
end.