Вот написал компонент TPosBar - его недостаток мигание, подскажите как его убрать?
unit posbar;
interface
uses Windows,Forms,Messages,Classes,Dialogs,Variants,Controls,ExtCtrls,Graphics,StdCt rls,SysUtils;
type
TPosBar = class(TCustomControl)
private
MyClicked: Boolean;
PosX: Integer;
Multi: Integer;
protected
FPosition: Integer;
FOnClick: TNotifyEvent;
FMax: Integer;
FMin: Integer;
FBackground: TPicture;
FSeek: TPicture;
FSeekMove: TPicture;
FTimer: TTimer;
procedure SetMaxPosition(Value: Integer);
procedure SetMinPosition(Value: Integer);
procedure SetPosition(Value:Integer);
procedure SetBackground(Value: TPicture);
procedure SetSeek(Value: TPicture);
procedure SetSeekMove(Value: TPicture);
procedure TimerTimer(Sender: TObject);
procedure WMLButtonDown(var Message:TWMLButtonDown);message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message:TWMLButtonUp);message WM_LBUTTONUp;
procedure WMLButtonMove(var Message:TWMMOUSEMOVE);message WM_MOUSEMOVE;
procedure Click; override;
public
procedure Paint;override;
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
property Position: Integer read FPosition write SetPosition;
property Min: Integer read FMin write SetMinPosition;
property Max: Integer read FMax write SetMaxPosition;
property Background: TPicture read FBackground write SetBackground;
property Seek: TPicture read FSeek write SetSeek;
property SeekMove: TPicture read FSeekMove write SetSeekMove;
property onClick;
property onMouseDown;
property onMouseMove;
property onMouseUp;
end;
implementation
uses main,pogiengine;
function GetPeriodFromSec(const Sec: Integer): String;
var H, M, S: Integer;
begin
H:=Sec div 3600;
S:=Sec mod 3600;
M:=S div 60;
S:=(S mod 60);
if H <> 0 then
Result:=Format('%2.2d:%2.2d:%2.2d', [H,M,S])
else
Result:=Format('%2.2d:%2.2d', [M,S]);
end;
procedure TPosBar.WMLButtonDown(var Message:TWMLButtonDown);
begin
inherited;
MyClicked:= True;
PosX:= Message.XPos - SeekMove.Width div 2;
TimeChange:= 1;
end;
procedure TPosBar.WMLButtonUp(var Message:TWMLButtonUp);
begin
inherited;
MyClicked:= False;
FPosition:= PosX;
Bass_ChannelSetPosition(MainChannel,Round(PosX * Multi),Bass_pos_Byte);
TimeChange:= 0;
end;
procedure TPosBar.WMLButtonMove(var Message:TWMMOUSEMOVE);
var
S: Integer;
G: Float;
begin
inherited;
if Myclicked then begin
PosX:= Message.XPos - SeekMove.Width div 2;
if PosX <= 0 then PosX:= 0;
if PosX >= Width - (SeekMove.Width) then PosX:= Width - (SeekMove.Width);
G:= BASS_ChannelBytes2Seconds(MainChannel,PosX * Multi);
TimeText:=FormatFloat('000',G);
TimeText:= GetPeriodFromSec(StrToInt(TimeText));
end;
end;
procedure TPosBar.Click;
begin
inherited;
end;
procedure TPosBar.TimerTimer(Sender: TObject);
begin
Multi:= Fmax div (Width - Seek.Bitmap.Width);
end;
procedure TPosBar.SetBackground(Value: TPicture);
begin
FBackground.Assign(Value);
end;
procedure TPosBar.SetSeek(Value:TPicture);
begin
FSeek.Assign(Value);
end;
procedure TPosBar.SetSeekMove(Value: TPicture);
begin
FSeeKmove.Assign(Value);
end;
constructor TPosBar.Create(AOWner: TComponent);
begin
inherited;
FMax:= 100;
FMin:= 0;
FPosition:= 1;
FBackground:= TPicture.Create;
Cursor:= crHandPoint;
FSeek:= TPicture.Create;
FTimer:= TTimer.Create(nil);
FTimer.Interval:= 33;
FTImer.OnTimer:= TimerTimer;
MyClicked:= False;
FSeekMove:= TPicture.Create;
end;
destructor TPosBar.Destroy;
begin
inherited;
end;
procedure TPosBar.Paint;
begin
inherited;
Canvas.Draw(0,0,FBackground.Graphic);
if Multi <= 0 then Multi:= 1;
Canvas.Draw(FPosition div Multi,0,Seek.Graphic);
if MyClicked then
Canvas.Draw(PosX,0,SeekMove.Graphic);
end;
procedure TPosBar.SetPosition(Value: Integer);
begin
if FPosition = Value then Exit;
if Value < FMin then Value:= FMin;
if Value > FMax then Value:= FMax;
FPosition:= Value;
Paint;
end;
procedure TPosBar.SetMaxPosition(Value: Integer);
begin
if FMax = Value then Exit;
FMax:= Value;
end;
procedure TPosBar.SetMinPosition(Value: Integer);
begin
if FMin = Value then Exit;
FMin:= Value;
end;
end.