Como siempre he creado un nuevo Speedbuttón, al que seguro habrá que hacer mejoras, pero que sirve de base, la idea es usarlo en los TPV, nació de la necesidad de crear un plano con la situación de mesas, taburetes, etc, espero os sea de ayuda
Código Delphi
[-]
unit SBTPV;
interface
uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
Forms, Graphics, Buttons, DbTables, DB;
type
TStyleBorde=(SbNone, SbComplet,SbUp,SbDown,SbLeft,SbRight,SbUpDown,SbLeftRight);
TButtonStyle=(SbtImagen,SbtColor,SbtImagenColor);
TMyType=(MMesa,MTaburete,MTerraza,MBanco,MSofa,Motros);
TypeQuad=(TRound,TRrectangle,TTriangleUp,TTriangleDown,TTriangleLeft,TTriangleRight);
TSpeedButtonTPV = class(TSpeedButton)
private
FAnchoBorde : Integer;
FBordeSpace : Integer;
FButonStyle : TButtonStyle;
FColor : TColor;
FColorReserva : TColor;
FColorUnit : TColor;
FColorUsed : TColor;
FColorLibre : TColor;
FComensales : Integer;
FId : Integer;
FLeftQuad : Integer;
FLongQuad : Integer;
FNumeroTicket : String;
FOcupada : Boolean;
FReserva : Boolean;
FUnidas : Boolean;
FStyleBorde : TStyleBorde;
FTopQuad : Integer;
FTotalComensales : Integer;
FMyType : TMyType;
FTypeQuad : TypeQuad;
FUsedQuad : Boolean;
FTopCaption: Integer;
FLeftCaption: Integer;
FImageLong: Integer;
FImagenTop: Integer;
FImagenLeft: Integer;
procedure AutoInitialize;
procedure AutoDestroy;
procedure SetAnchoBorde(Value : Integer);
procedure SetBordeSpace(Value : Integer);
procedure SetButonStyle(Value : TButtonStyle);
procedure SetColor(Value : TColor);
procedure SetColorReserva(Value : TColor);
procedure SetColorUnit(Value : TColor);
procedure SetColorUsed(Value : TColor);
procedure SetColorLibre(Value : TColor);
procedure SetComensales(Value : Integer);
procedure SetId(Value : Integer);
procedure SetLeftQuad(Value : Integer);
procedure SetLongQuad(Value : Integer);
procedure SetNumeroTicket(Value : String);
procedure SetOcupada(Value : Boolean);
procedure SetReserva(Value : Boolean);
procedure SetStyleBorde(Value : TStyleBorde);
procedure SetTopQuad(Value : Integer);
procedure SetTotalComensales(Value : Integer);
procedure SetMyType(Value : TMyType);
procedure SetTypeQuad(Value : TypeQuad);
procedure SetUsedQuad(Value : Boolean);
procedure SetTopCaption(value:Integer);
procedure SetLeftCaption(value:Integer);
procedure SetUnidas(value:Boolean);
procedure SetImageLong(value:Integer);
procedure SetImagenTop(value:Integer);
procedure SetImagenLeft(value:Integer);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
procedure Click; override;
procedure Loaded; override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property AnchoBorde : Integer read FAnchoBorde write SetAnchoBorde default 5;
property BordeSpace : Integer read FBordeSpace write SetBordeSpace default 2;
property ButonStyle : TButtonStyle read FButonStyle write SetButonStyle;
property Color : TColor read FColor write SetColor default ClbtnFace;
property ColorReserva : TColor read FColorReserva write SetColorReserva default clBlue;
property ColorUnit : TColor read FColorUnit write SetColorUnit default clPurple;
property ColorUsed : TColor read FColorUsed write SetColorUsed default clTeal;
property Colorlibre : TColor read FColorlibre write SetColorlibre default clRed;
property Comensales : Integer read FComensales write SetComensales;
property Id : Integer read FId write SetId;
property LeftQuad : Integer read FLeftQuad write SetLeftQuad;
property LongQuad : Integer read FLongQuad write SetLongQuad default 20;
property NumeroTicket : String read FNumeroTicket write SetNumeroTicket;
property Ocupada : Boolean read FOcupada write SetOcupada;
property Reserva : Boolean read FReserva write SetReserva;
property StyleBorde : TStyleBorde read FStyleBorde write SetStyleBorde;
property TopQuad : Integer read FTopQuad write SetTopQuad;
property TotalComensales : Integer read FTotalComensales write SetTotalComensales;
property MYType : TMyType read FMyType write SetMyType;
property TypeQuad : TypeQuad read FTypeQuad write SetTypeQuad;
property UsedQuad : Boolean read FUsedQuad write SetUsedQuad default True;
property Unidas : Boolean read FUnidas write SetUnidas default False;
property TopCaption : Integer read FTopCaption write SetTopCaption default 0;
property LeftCaption : Integer read FLeftCaption write SetLeftCaption default 0;
property ImageLong : Integer read FImageLong write SetImageLong default 0;
property ImagenLeft : Integer read FImagenLeft write SetImagenLeft default 0;
property ImagenTop : Integer read FImagenTop write SetImagenTop default 0;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TSpeedButtonTPV]);
end;
procedure TSpeedButtonTPV.AutoInitialize;
begin
FAnchoBorde := 5;
FBordeSpace := 2;
FColor := ClbtnFace;
FColorReserva := clBlue;
FColorUnit := clPurple;
FColorUsed := clTeal;
FColorlibre := clRed;
FLongQuad := 20;
FStyleBorde := SbComplet;
FButonStyle := SbtColor;
FUsedQuad := True;
FMyType := MMesa;
FTypeQuad := TRound;
if FMyType=MTaburete then FComensales:=1;
FTotalComensales := 0;
FTopCaption := 0;
FLeftCaption := 0;
FUnidas := False;
Width := 70;
Height := 70;
FTopQuad := 25;
FLeftQuad := 44;
FImageLong := 32;
FImagenTop := 7;
FImagenLeft := 7;
end;
procedure TSpeedButtonTPV.AutoDestroy;
begin
end;
procedure TSpeedButtonTPV.SetAnchoBorde(Value : Integer);
begin
if FAnchoBorde<>Value then FAnchoBorde := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetBordeSpace(Value : Integer);
begin
if FBordeSpace<>Value then FBordeSpace := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetButonStyle(Value : TButtonStyle);
begin
if FButonStyle<>Value then FButonStyle := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetColor(Value : TColor);
begin
if FColor<>Value then FColor := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetColorReserva(Value : TColor);
begin
if FColorReserva<>Value then FColorReserva := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetColorUnit(Value : TColor);
begin
if FColorUnit<>Value then FColorUnit := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetColorUsed(Value : TColor);
begin
if FColorUsed<>Value then FColorUsed := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetColorLibre(Value : TColor);
begin
if FColorLibre<>Value then FColorLibre := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetComensales(Value : Integer);
begin
if FComensales<>Value then FComensales := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetId(Value : Integer);
begin
if FId<>Value then FId := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetLeftQuad(Value : Integer);
begin
if FLeftQuad<>Value then FLeftQuad := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetLongQuad(Value : Integer);
begin
if FLongQuad<>Value then FLongQuad := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetNumeroTicket(Value : String);
begin
if FNumeroTicket<>Value then FNumeroTicket := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetOcupada(Value : Boolean);
begin
if FOcupada<>Value then FOcupada := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetReserva(Value : Boolean);
begin
if FReserva<>Value then FReserva := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetStyleBorde(Value : TStyleBorde);
begin
if FStyleBorde<>Value then FStyleBorde := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetTopQuad(Value : Integer);
begin
if FTopQuad<>Value then FTopQuad := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetTotalComensales(Value : Integer);
begin
if FTotalComensales<>Value then FTotalComensales := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetMyType(Value : TMyType);
begin
if FMyType<>Value then FMyType := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetTypeQuad(Value : TypeQuad);
begin
if FTypeQuad<>Value then FTypeQuad := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetUsedQuad(Value : Boolean);
begin
if FUsedQuad<>Value then FUsedQuad := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetTopCaption(Value : Integer);
begin
if FTopCaption<>Value then FTopCaption := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetLeftCaption(Value : Integer);
begin
if FLeftCaption<>Value then FLeftCaption := Value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetUnidas(value: Boolean);
begin
if FUnidas<>Value then FUnidas:=value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetImageLong(value: Integer);
begin
if FImageLong<>value then FImageLong:=value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetImagenTop(value: Integer);
begin
if FImagenTop<>Value then FImagenTop:=value;
Invalidate;
end;
procedure TSpeedButtonTPV.SetImagenLeft(value: Integer);
begin
if FImagenLeft<>Value then FImagenLeft:=value;
Invalidate;
end;
procedure TSpeedButtonTPV.Click;
begin
if Ocupada then FOcupada:=False
else FOcupada:=true;
inherited Click;
Repaint;
end;
constructor TSpeedButtonTPV.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoInitialize;
end;
destructor TSpeedButtonTPV.Destroy;
begin
AutoDestroy;
inherited Destroy;
end;
procedure TSpeedButtonTPV.Loaded;
begin
inherited Loaded;
end;
procedure TSpeedButtonTPV.Paint;
var VarILArgo,VarIAlto,VarISuma:Integer;
R:TRect;
var
Puntos: array of TPoint; begin
inherited Paint;
Canvas.Pen.Color:=FColor;
Canvas.Pen.Width:=FAnchoBorde;
if FStyleBorde<>sbNone then
begin
if (FStyleBorde=sbComplet) or (FStyleBorde=sbUp) or (FStyleBorde=sbUpDown) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbDown) or (FStyleBorde=sbUpDown) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbLeft) or (FStyleBorde=sbLeftRight) then
begin Canvas.MoveTo(FBordeSpace+FAnchoBorde,FBordeSpace+FAnchoBorde);
Canvas.LineTo(FBordeSpace+FAnchoBorde,Height-(FBordeSpace+FAnchoBorde));
end;
if (FStyleBorde=sbComplet) or (FStyleBorde=sbRight) or (FStyleBorde=sbLeftRight) then
begin Canvas.MoveTo(Width-(FBordeSpace+FAnchoBorde),FBordeSpace+FAnchoBorde);
Canvas.LineTo(Width-(FBordeSpace+FAnchoBorde),Height-(FBordeSpace+FAnchoBorde));
end;
end;
if FButonStyle=SbtColor then
begin Canvas.Pen.Width:=0;
if FOcupada then Canvas.Brush.Color:=FColorUsed
else Canvas.Brush.Color:=FColorLibre;
if FUnidas then Canvas.Brush.Color:=FColorUnit;
if FReserva then Canvas.Brush.Color:=FColorReserva;
Canvas.Brush.Style:=bsSolid;
Canvas.Rectangle(FBordeSpace+FAnchoBorde+3,FBordeSpace+FAnchoBorde+3,Width-(FBordeSpace+FAnchoBorde+2),Height-(FBordeSpace+FAnchoBorde+2));
Canvas.Font:=Self.Font;
VarILArgo:=Canvas.TextWidth(Self.Caption);
VarIAlto:=Canvas.TextHeight(Self.Caption);
Canvas.TextOut(((Width div 2)-(VarILArgo div 2)+FLeftCaption),((Height div 2)-(VarIAlto div 2)+FTopCaption),Self.Caption);
end;
if FButonStyle=SbtImagenColor then
begin Canvas.Pen.Width:=0;
if FOcupada then Canvas.Brush.Color:=FColorUsed
else Canvas.Brush.Color:=FColorLibre;
if FUnidas then Canvas.Brush.Color:=FColorUnit;
if FReserva then Canvas.Brush.Color:=FColorReserva;
Canvas.Brush.Style:=bsSolid; Canvas.Rectangle(FBordeSpace+FAnchoBorde+2,FBordeSpace+FAnchoBorde+2,Width-(FBordeSpace+FAnchoBorde+1),Height-(FBordeSpace+FAnchoBorde+1));
Canvas.Font:=Self.Font;
VarILArgo:=Canvas.TextWidth(Self.Caption);
VarIAlto:=Canvas.TextHeight(Self.Caption);
VarISuma:=FBordeSpace+FAnchoBorde+1;
r:=Rect(FImagenLeft,FImagenTop,FImagenLeft+FImageLong,FImagenTop+FImageLong);
if FOcupada then Canvas.Pen.Color:=FColorUsed
else Canvas.Pen.Color:=FColorLibre;
if FUnidas then Canvas.Pen.Color:=FColorUnit;
if FReserva then Canvas.Pen.Color:=FColorReserva;
Canvas.Pen.Style:=psClear;
Canvas.Pen.Width:=0;
Glyph.Transparent:=True;
Canvas.DrawFocusRect(R);
Canvas.CopyMode:=cmSrcPaint; Canvas.StretchDraw(R,Glyph);
Canvas.StretchDraw(R,Glyph); Canvas.Brush.Style:=bsClear;
Canvas.Pen.Style:=psSolid;
Canvas.Pen.Width:=1;
Canvas.Font.Color:=RGB(255 - GetRValue(Font.Color),255 - GetGValue(Font.Color),255 - GetBValue(Font.Color));
Canvas.Font.Style:=[fsBold];
Canvas.TextOut((((Width div 2)-(VarILArgo div 2)+FLeftCaption)-2),((Height div 2)-(VarIAlto div 2)+FTopCaption),Self.Caption);
Canvas.TextOut((((Width div 2)-(VarILArgo div 2))+FLeftCaption),(((Height div 2)-(VarIAlto div 2)-2)+FTopCaption),Self.Caption);
Canvas.font.color:=Font.Color;
Canvas.Font.Size:=Font.Size;
Canvas.Font.Style:=[fsBold];
Canvas.TextOut(((Width div 2)-(VarILArgo div 2)+FLeftCaption),((Height div 2)-(VarIAlto div 2)+FTopCaption),Self.Caption);
end;
if UsedQuad then
begin
if FOcupada then Canvas.Brush.Color:=FColorUsed
else Canvas.Brush.Color:=FColorLibre;
Canvas.Pen.Width:=2;
Canvas.Pen.Color:=FColor;
case FTypeQuad of
TRound: Canvas.Ellipse(FLeftQuad,FTopQuad,FLeftQuad+FLongQuad,FTopQuad+FLongQuad);
TRrectangle: Canvas.Rectangle(FLeftQuad,FTopQuad,FLeftQuad+FLongQuad,FTopQuad+FLongQuad);
TTriangleUp: begin
with Canvas do
begin
SetLength( Puntos, 3 );
Puntos[0].x := FLeftQuad;
Puntos[0].y := FTopQuad+FLongQuad;
Puntos[1].x := FLeftQuad+FLongQuad;
Puntos[1].y := FTopQuad+FLongQuad;
Puntos[2].x := FLeftQuad+((FLongQuad div 2));
Puntos[2].y := FTopQuad;
Polygon( Puntos );
end;
end;
TTriangleDown:begin
with Canvas do
begin
SetLength( Puntos, 3 );
Puntos[0].x := FLeftQuad;
Puntos[0].y := FTopQuad;
Puntos[1].x := FLeftQuad+FLongQuad;
Puntos[1].y := FTopQuad;
Puntos[2].x := FLeftQuad+((FLongQuad div 2));
Puntos[2].y := FTopQuad+FLongQuad;
Polygon( Puntos );
end;
end;
TTriangleLeft:begin
with Canvas do
begin
SetLength( Puntos, 3 );
Puntos[0].x := FLeftQuad+FLongQuad;
Puntos[0].y := FTopQuad;
Puntos[1].x := FLeftQuad+FLongQuad;
Puntos[1].y := FTopQuad+FLongQuad;
Puntos[2].x := FLeftQuad;
Puntos[2].y := FTopQuad+((FLongQuad div 2));
Polygon( Puntos );
end;
end;
TTriangleRight:begin
with Canvas do
begin
SetLength( Puntos, 3 );
Puntos[0].x := FLeftQuad;
Puntos[0].y := FTopQuad;
Puntos[1].x := FLeftQuad;
Puntos[1].y := FTopQuad+FLongQuad;
Puntos[2].x := FLeftQuad+FLongQuad;
Puntos[2].y := FTopQuad+((FLongQuad div 2));
Polygon( Puntos );
end;
end;
end;
end;
end;
procedure TSpeedButtonTPV.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
W := Width;
H := Height;
if (W <> Width) or (H <> Height) then
inherited SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
end.
El código como podéis ver no esta depurado ya que no he terminado con el