Pessoal, eu estou tentando fazer um componente e gostaria de uma força em
alguns detalhes.
O pepino é o seguinte:
Estou montando um botão baseado no TShape, que no onMouseMove e no
OnMoseDown mudam de cor, e no onClick toca um wav.
Funciona, porém estou com dificuldade nos seguintes detalhes.
Quando o mouse sai do objeto ele não volata as cores. Volta apenas se sair
por baixo ou pela direita.
Outra questão é que se mudar as propriedades em DesignTime ela não atualizam
o objeto, só atualiza se eu colocar alguma tela sobre ele e depois
vizualiza-lo novamente.
Outra coisa que é necessário implementar é a mudança da cor da fonte.
Se alguém quiser dar uma força eu agradeço.
Se alguém gostar e quiser usar sinta-se à vontade.
Um Abração,
Benn
Abaixo a unit
**********************************
//TCoolPlainButton by 83NN [EMAIL PROTECTED]
//Colocar no evento onMouseMoveDoForm
//var i:integer;
//begin
// if tag = 1 then
// begin
// for i:=0 to ComponentCount-1 do
// begin
// if Components[i] is TCoolPlainBtn then
// TCoolPlainBtn(Components[i]).VoltarEstado(self);
// end
// {end for};
// tag := 0;
// end
// {end if};
//end;
unit CoolPlainBtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls,WinTypes, WinProcs, StdCtrls, Buttons,MMSystem;
type
TSoundPlayOption = (spPlayReturn, spPlayNoReturn,spPlayMemoryFile,
spPlayContinuous, spEndSoundPlay);
TCoolPlainBtnType = (stRectangle, stSquare, stRoundRect, stRoundSquare,
stEllipse, stCircle, stStar);
TCoolPlainBtn = class(TShape)
private
{ Private declarations }
// FFont:TFont;
FCaption:String;
FSoundPlayOption : TSoundPlayOption;
FSoundFile : String;
// FSoundEnable : boolean;
FColorMouseMove : TColor;
FColorMouseDown : TColor;
FColorMouseLeave : TColor;
FMouseSobre : boolean;
FRegion: HRGN;
FPen: TPen;
FBrush: TBrush;
FMouseInControl, FDragging: Boolean;
FShape: TCoolPlainBtnType;
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
FCaptionPx:Integer;
FCaptionPy:Integer;
procedure SetBrush(Value: TBrush);
procedure SetPen(Value: TPen);
procedure SetShape(Value: TCoolPlainBtnType);
procedure MouseEnter;
procedure MouseLeave;
// procedure VoltaCores;
protected
{ Protected declarations }
procedure Paint; 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
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Click; override;
destructor Destroy; override;
procedure DrawStar(Rect: TRect);
procedure DrawRectangle(A, B, C, D: Integer);
procedure DrawRoundRect(A, B, C, D, E, F: Integer);
procedure DrawEllipse(A, B, C, D: Integer);
published
{ Published declarations }
procedure VoltarEstado(Sender: TObject);
procedure StyleChanged(Sender: TObject);
property Align;
property Anchors;
property Brush: TBrush read FBrush write SetBrush;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Constraints;
property MouseInControl: Boolean read FMouseInControl write
FMouseInControl;
property ParentShowHint;
property Pen: TPen read FPen write SetPen;
property Shape: TCoolPlainBtnType read FShape write SetShape default
stRectangle;
property ShowHint;
property Visible;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write
FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write
FOnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
property OnClick;
property SoundPlayOption : TSoundPlayOption read FSoundPlayOption
write FSoundPlayOption default spPlayReturn;
property SoundFile : String read FSoundFile write FSoundFile;
// property SoundEnable : boolean read FSoundEnable write FSoundEnable;
property Caption : String read FCaption write FCaption;
property ColorMouseMove : TColor read FColorMouseMove write
FColorMouseMove;
property ColorMouseDown : TColor read FColorMouseDown write
FColorMouseDown;
property ColorMouseLeave : TColor read FColorMouseLeave write
FColorMouseLeave;
property MouseSobre : boolean read FMouseSobre write FMouseSobre;
property CaptionPx : integer read FCaptionPx write FCaptionPx;
property CaptionPy : integer read FCaptionPy write FCaptionPy;
end;
procedure Register;
implementation
uses Math;
procedure Register;
begin
RegisterComponents('Standard', [TCoolPlainBtn]);
end;
{ TShape }
constructor TCoolPlainBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
FPen := TPen.Create;
FPen.Style := psClear;
FPen.OnChange := StyleChanged;
FBrush := TBrush.Create;
FBrush.OnChange := StyleChanged;
FMouseInControl := False;
FSoundFile := 'tac.wav';
// FSoundEnable := true;
FColorMouseLeave:= $0075C1FF;;
FColorMouseMove := $00008CFF;
FColorMouseDown := $000074D2;
Canvas.Font.Name := 'Arial';
Canvas.Font.Color := clWhite;
Canvas.Font.Size := 8;
Canvas.Font.Style := [fsBold,fsItalic];
Brush.Color := $0075C1FF;
Shape := stRoundRect;
Width := 123;
Height := 22;
cursor := crHandPoint;
FMouseSobre := false;
FCaption:='CoolPlainBtn';
FCaptionPx := 2;
FCaptionPy := 4;
ShowHint := True;
Hint := '';
end;
destructor TCoolPlainBtn.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited Destroy;
end;
procedure TCoolPlainBtn.Paint;
var
X, Y, W, H, S: Integer;
Rect: TRect;
begin
Rect := Self.GetClientRect;
with Canvas do
begin
Pen := FPen;
Brush := FBrush;
X := Pen.Width div 2;
Y := X;
W := Width - Pen.Width + 1;
H := Height - Pen.Width + 1;
if Pen.Width = 0 then
begin
Dec(W);
Dec(H);
end;
if W < H then S := W else S := H;
if FShape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
case FShape of
stRectangle, stSquare:
DrawRectangle(X, Y, X + W, Y + H);
stRoundRect, stRoundSquare:
DrawRoundRect(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse:
DrawEllipse(X, Y, X + W, Y + H);
stStar:
DrawStar(Rect);
end;
end;
end;
procedure TCoolPlainBtn.DrawRectangle(A, B, C, D: Integer);
begin
FRegion := CreateRectRgn(A+2, B+2, C-2, D-2);
Canvas.Rectangle(A+2, B+2, C-2, D-2);
end;
procedure TCoolPlainBtn.DrawRoundRect(A, B, C, D, E, F: Integer);
begin
FRegion := CreateRoundRectRgn(A, B, C, D, E, F);
Canvas.RoundRect(A, B, C, D, E, F);
Canvas.TextOut(FCaptionPx,FCaptionPy,FCaption);
Canvas.TextOut(FCaptionPx,FCaptionPy,FCaption);
end;
procedure TCoolPlainBtn.DrawEllipse(A, B, C, D: Integer);
begin
FRegion := CreateEllipticRgn(A, B, C, D);
Canvas.Ellipse(A, B, C, D);
end;
procedure TCoolPlainBtn.DrawStar(Rect: TRect);
var
i, x, y, xx, yy: Integer;
p: array[0..9] of TPoint;
t, r, sv, sw, sx, sy, s: Real;
begin
sx := (Rect.Right-Rect.Left)*0.48;
sy := (Rect.Bottom-Rect.Top)*0.5;
if sx > sy then
sx := sy
else
sy := sx;
sv := (Rect.Left + Rect.Right) / 2;
sw := (Rect.Top + Rect.Bottom * 1.2) / 2.2;
for i := 0 to 10 do
begin
if ((i and 1) <> 0) then
r := 1
else
r := 0.384;
t := i * 2 * (PI/10);
P[i].x := Trunc(sv+sx*r*sin(t));
P[i].Y := Trunc(sw+sy*r*cos(t));
end;
FRegion := CreatePolygonRgn(P, 10, WINDING);
Self.Canvas.Polygon(P);
end;
procedure TCoolPlainBtn.SetShape(Value: TCoolPlainBtnType);
begin
if FShape <> Value then
begin
FShape := Value;
Invalidate;
end;
end;
procedure TCoolPlainBtn.StyleChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TCoolPlainBtn.SetBrush(Value: TBrush);
begin
FBrush.Assign(Value);
end;
procedure TCoolPlainBtn.SetPen(Value: TPen);
begin
FPen.Assign(Value);
end;
procedure TCoolPlainBtn.MouseEnter;
begin
if (FMouseInControl) and (not FMouseSobre)then
begin
if SoundFile <> 'nosound' then
begin
case FSoundPlayOption of
spPlayReturn : sndPlaySound(@FSoundFile[1], snd_Async or
snd_NoDefault);
spPlayNoReturn : sndPlaySound(@FSoundFile[1], snd_Sync or
snd_NoDefault);
spPlayMemoryFile : sndPlaySound(@FSoundFile[1], snd_Memory or
snd_NoDefault);
spPlayContinuous : sndPlaySound(@FSoundFile[1], snd_Loop or
snd_NoDefault);
spEndSoundPlay : sndPlaySound(nil, snd_Async or
snd_NoDefault);
end;
end
else
showmessage('sem som 2')
{end if};
Brush.Color := FColorMouseMove;
FMouseSobre := true;
end
{end if};
if (FMouseInControl) and (Assigned(FOnMouseEnter)) then
begin
FOnMouseEnter(Self);
end
{end if};
end;
procedure TCoolPlainBtn.MouseLeave;
begin
if (not FMouseInControl) then
begin
Brush.Color := FColorMouseLeave;
FMouseSobre := false;
end
{end if};
if (not FMouseInControl) and (Assigned(FOnMouseLeave)) then
begin
FOnMouseLeave(Self);
end
{end if};
end;
procedure TCoolPlainBtn.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if PtInRegion(FRegion, X, Y) then
begin
Parent.Tag := 1;
FMouseInControl := True;
MouseEnter;
end
else
begin
FMouseInControl := False;
MouseLeave;
end;
end;
procedure TCoolPlainBtn.Click;
begin
if SoundFile<>'nosound' then
begin
case FSoundPlayOption of
spPlayReturn : sndPlaySound(@FSoundFile[1], snd_Async or
snd_NoDefault);
spPlayNoReturn : sndPlaySound(@FSoundFile[1], snd_Sync or
snd_NoDefault);
spPlayMemoryFile : sndPlaySound(@FSoundFile[1], snd_Memory or
snd_NoDefault);
spPlayContinuous : sndPlaySound(@FSoundFile[1], snd_Loop or
snd_NoDefault);
spEndSoundPlay : sndPlaySound(nil, snd_Async or snd_NoDefault);
end;
end
else
begin
showmessage('sem som 1')
end
{end if};
inherited Click;
end;
procedure TCoolPlainBtn.VoltarEstado(Sender: TObject);
begin
if FMouseSobre then
begin
Brush.Color := FColorMouseLeave;
FMouseSobre := false;
end
{end if};
end;
procedure TCoolPlainBtn.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
Brush.Color := FColorMouseDown;
end;
procedure TCoolPlainBtn.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited;
Brush.Color := FColorMouseMove;
end;
end.
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
<*> Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
<*> Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
