3

Bueno espero si es posible que me ayuden. Hace tiempo vengo usando un componente que realice en VCL para delphi 2010 que consta de un rectángulo que cambia de color según tres estados como se muestra en la imagen anexa. Con tres campos adicionales gráficos en forma de texto y otros tres mas no gráficos.

  1. Estado ocupado: Color rojo;
  2. Estado libre: color gris claro;
  3. Estado seleccionado: color gis oscuro.

descripción del componente a realizar

Realmente el componente funciona de maravilla para el cometido que le estaba dando, que es el control de puestos de estacionamientos.

El problema empieza al transformar el programa realizado hace unos 4 anos en VCL a FireMonkey para que pueda correr en MAC y Windowns. Tengo toda la programación lista de la base de datos, la conexión con el servidor remoto pero el componente principal no lo he podido transformar a FMX, tengo algún tiempo intentando pero no me sale nada.

Este es el código del componente realizado para VCL en Delphi.

unit uTPuestoVCL;

interface

uses
  System.SysUtils, 
  System.Classes, 
  Vcl.Controls, 
  Vcl.Graphics, 
  Messages, 
  Windows,
  System.AnsiStrings;
type

  TMyState = (msLibre, msOcupado);

  TPuesto = class(TCustomControl)
  private
    FId : Integer;
    FPicture:TPicture;
    FColors:array[0..6] of TColor;

    FOnMouseEnter,
    FOnMouseLeave:TNotifyEvent;
    FBorder:Boolean;
    FBorderWidth:Integer;
    FOver:Boolean;
    FPosXPicture:Word;
    FText:TCaption;
    FTextFont:TFont;
    FPosXText:Word;
    FAlignment,
    FTextAlign: TAlignment;

    {Texto Indicando el puesto}
    FPuesto:String;
    FPuestoFont:TFont;
    FPuestoFontAlign:TAlignment;

    {Status-delobjeto}
    FState : TMyState;
    FDataInicio:TDateTime;

    FPlaca:String;

    procedure SetPuesto(value:String);
    function getPuesto:String;

    procedure SetDataInicio(value:TDateTime);
    function getDataInicio:TDateTime;

    procedure SetPlaca(Value:String);
    function getPlaca:String;

    procedure SetId(Value:Integer);
    //function getId(Valuer:Integer):Integer;

    procedure SetPuestoFontAlign(Value: TAlignment);
    procedure SetPuestoFont(Value:TFont);

    procedure SetPicture(Value:TPicture);

    procedure SetColors(Index:Integer;Value:TColor);
    function  GetColors(Index:integer):TColor;

    procedure SetBorder(Value:Boolean);
    procedure SetBorderWidth(Value:integer);
    procedure SetPosXPicture(Value:Word);
    procedure SetText(Value:TCaption);
    procedure SetPosXText(Value:Word);
    procedure SetTextFont(Value:TFont);
    procedure FontChanged(Sender: TObject);
    procedure SetAlignment(Value: TAlignment);
    procedure SetTextAlign(Value: TAlignment);

    procedure setState(Value:TMyState);
    function  getState:TMyState;

    procedure setChangeStatus;
    { Private declarations }
  protected
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

    procedure Paint; override;
    procedure KeyPress(var Key: Char);override;
    procedure Click;override;
    procedure DblClick;override;
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    property Colors[Index:Integer]:TColor read GetColors Write SetColors;
    Procedure SetAllTexts(S:String);
    { Public declarations }
  published
     property FechaInicio:TDateTime read getDataInicio write SetDataInicio;
     property Placa:String read getPlaca write setPlaca;
     Property Status:TMyState read getState write setState default msLibre;
     property Id:Integer read FId write SetId default 0;
     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
     property TextAlign: TAlignment read FTextAlign write SetTextAlign default taLeftJustify;

     property Puesto:String read getPuesto write setPuesto;
     property PuestoTextoAlign: TAlignment read FPuestoFontAlign write SetPuestoFontAlign default taCenter;
     property PuestoTextFont:TFont read FPuestoFont Write SetPuestoFont;

     property Picture:TPicture read FPicture Write SetPicture;
     property Border:Boolean read FBorder Write SetBorder default True;
     property BorderWidth:integer read FBorderWidth Write SetBorderWidth default 1;

     property Color:TColor Index 0 read GetColors Write SetColors default clBtnFace;



     property FocusedColor:TColor Index 2 read GetColors Write SetColors default clBtnHighlight;
     property OverColor:TColor Index 4 read GetColors Write SetColors default clBtnShadow;
     property ActiveColor:TColor Index 6 read GetColors Write SetColors default clRed;

     property OverBorderColor:TColor Index 5 read GetColors Write SetColors default clBlack;
     property BorderColor:TColor Index 1 read GetColors Write SetColors default clBlack;
     property FocusedBorderColor:TColor Index 3 read GetColors Write SetColors default clBlack;


     property PosXPicture:Word read FPosXPicture Write SetPosXPicture default 10;
     property PosXText:Word read FPosXText Write SetPosXText default 10;
     property Caption;

     property Text:TCaption read FText Write SetText;
     property TextFont:TFont read FTextFont Write SetTextFont;

     property Font;
     property Tabstop;
     property BiDiMode;
     property TabOrder;
     property Action;
     property Align;
     property Anchors;
     property Visible;
     property Enabled;
     property Constraints;
     property DragCursor;
     property DragKind;
     property DragMode;
     property ParentBiDiMode;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ShowHint;
     property OnMouseEnter:TNotifyEvent read FOnMouseEnter Write FOnMouseEnter;
     property OnMouseLeave:TNotifyEvent read FOnMouseLeave Write FOnMouseLeave;
     property OnClick;
     property OnContextPopup;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDock;
     property OnEndDrag;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnStartDock;
     property OnStartDrag;
     property OnEnter;
     property OnExit;
    { Published declarations }
  end;
Function _BiDiMode(Alignment: TAlignment;BiDi:TBiDiMode):TAlignment;
procedure Register;

implementation

Function _BiDiMode(Alignment: TAlignment;BiDi:TBiDiMode):TAlignment;
begin
  Result :=Alignment;
  if (SysLocale.MiddleEast) and (BiDi= bdRightToLeft) then
  case Alignment of
    taLeftJustify:  Result := taRightJustify;
    taRightJustify: result := taLeftJustify;
  end;
end;

Procedure TPuesto.SetAllTexts(S:String);
begin
   if S='' then
   begin
      Caption:='';
      Text:='';
   end
   else
      if pos('|',S)>0 then
      begin
         caption:=copy(S,1,pos('|',S)-1);
         text:=copy(S,pos('|',S)+1,length(S));
      end
      else
         Caption:=S;
end;

constructor TPuesto.Create(AOwner:TComponent);
begin
   inherited;

   Fid:=0;
   FOver:=False;
   Tabstop:=True;
   FBorder:=True;
   FBorderWidth:=1;
   FColors[0]:= clBtnFace;
   FColors[1]:=clBlack;
   FColors[2]:=clBtnHighlight;
   FColors[3]:=clBlack;
   FColors[4]:= clBtnShadow;
   FColors[5]:=clBlack;
   FColors[6]:=clRed;

   FPicture:=TPicture.Create;
   FTextFont:=TFont.Create;
   FTextFont.OnChange:=FontChanged;

   FPosXPicture:=10;
   FPosXText:=10;

   FText:='';
   Font.Style:=[fsBold];

   FAlignment:=taCenter;
   FTextAlign:=taCenter;
   FPuestoFontAlign:=taCenter;

   Puesto:=EmptyStr;
   FPuestoFont:=TFont.Create;
   FPuestoFont.OnChange:=FontChanged;
   FPuestoFont.Style:=[fsBold];

   ShowHint:=false;
   FState:=msLibre;
end;

procedure TPuesto.DblClick;
begin
  inherited;
  setChangeStatus;
  invalidate;
end;

destructor TPuesto.Destroy;
begin
   FTextFont.Destroy;
   FPicture.Destroy;
   inherited;
end;

procedure TPuesto.CMTextChanged(var Message: TMessage);
begin
   inherited;
   invalidate;
end;

procedure TPuesto.WMSetFocus(var Message: TWMSetFocus);
begin
   inherited;
   Invalidate;
end;

procedure TPuesto.WMKillFocus(var Message: TWMSetFocus);
begin
   inherited;
   Invalidate;
end;

procedure TPuesto.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  FOver:=True;
  Invalidate;
end;

procedure TPuesto.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  FOver:=False;
  Invalidate;
end;

procedure TPuesto.SetPicture(Value:TPicture);
begin
   FPicture.Assign(Value);
   repaint;
end;

procedure TPuesto.SetPlaca(Value: String);
begin
  if FPlaca<>Value then
  begin
    FPlaca:=Value;
    Invalidate;
  end;
end;

procedure TPuesto.SetPosXPicture(Value:Word);
begin
   if FPosXPicture<>Value then
      if value>0 then
      begin
         FPosXPicture:=Value;
         invalidate;
      end;
end;

procedure TPuesto.SetPosXText(Value:Word);
begin
   if FPosXText<>Value then
      if Value>0 then
      begin
         FPosXText:=Value;
         invalidate;
      end;
end;

procedure TPuesto.SetPuesto(value: String);
begin
  if FPuesto<> value then
  begin
     FPuesto:=Value;
     invalidate;
  end;
end;

procedure TPuesto.SetPuestoFont(Value: TFont);
begin
  FPuestoFont.Assign(Value);
end;

procedure TPuesto.SetPuestoFontAlign(Value: TAlignment);
begin
   if FPuestoFontAlign<>Value then
   begin
      FPuestoFontAlign:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.setState(Value: TMyState);
begin
  if FState<>Value then
  begin
     FState:=Value;
     invalidate;
  end;
end;

procedure TPuesto.SetText(Value: TCaption);
begin
   if FText<>Value then
   begin
      FText:=Value;
      invalidate;
   end;
end;

procedure TPuesto.SetTextFont(Value:TFont);
begin
   FTextFont.Assign(Value);
end;

procedure TPuesto.FontChanged(Sender: TObject);
begin
   invalidate;
end;

procedure TPuesto.SetBorder(Value:Boolean);
begin
   if FBorder<>Value then
   begin
      FBorder:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.SetBorderWidth(Value:integer);
begin
   if FBorderWidth<>Value then
   begin
      if Value>0 then
         FBorderWidth:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.SetColors(Index:Integer;Value:TColor);
begin
   if FColors[Index]<>Value then
   begin
      FColors[Index]:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.SetDataInicio(value: TDateTime);
begin
  if FDataInicio<>Value then
  begin
    FdataInicio:=Value;
    invalidate;
  end;
end;

procedure TPuesto.setId(Value: Integer);
begin
  if Fid<>Value then
  begin
    FId:=Value;
    Invalidate;
  end;
end;

Function TPuesto.GetColors(Index:Integer):TColor;
begin
   Result:=FColors[Index];
end;

function TPuesto.getDataInicio: TDateTime;
begin
  result:=FDataInicio;
end;

function TPuesto.getPlaca: String;
begin
 Result:=FPlaca;
end;

function TPuesto.getPuesto: String;
begin
  result:=FPuesto;
end;

function TPuesto.getState: TMyState;
begin
  Result:=FState;
end;

procedure  TPuesto.Click;
begin
   inherited;
   SetFocus;
end;
procedure TPuesto.KeyPress(var Key: Char);
begin
   if (Key=#13) or (Key=#32) then
      Click;
   Key:=#0;
end;

procedure TPuesto.SetAlignment(Value: TAlignment);
begin
   if FAlignment<>Value then
   begin
      FAlignment:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.SetTextAlign(Value: TAlignment);
begin
   if FTextAlign<>Value then
   begin
      FTextAlign:=Value;
      Invalidate;
   end;
end;

procedure TPuesto.Paint;
const
   AAlignment : array[taLeftJustify..taCenter] of uchar=(DT_LEFT,DT_RIGHT,DT_CENTER);
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
   despv:Integer;
   bmp: TBitmap;
   pic_empty: TBitmap;
   texto:String;
begin
   despv:=3;

   if border then
   begin
      despv:=despv+BorderWidth;
      //Desph:=BorderWidth-1;
   end;

   with Canvas do
   begin

      setbkmode(Handle,TRANSPARENT);
      Pen.Width:=BorderWidth;
      Pen.Color:=BorderColor;
      Brush.Style:=bsSolid;
      Brush.Color:=Color;
      X := Pen.Width div 2;
      Y := X;
      W := Width - Pen.Width + 1;
      H := Height - Pen.Width + 1;

      if FOver then
      begin
         Pen.Color:=OverBorderColor;
         Brush.Color:=OverColor;
      end;

      FillRect(ClientRect);
      Brush.Style:=bsClear;
      if Border then Rectangle(X, Y, X + W, Y + H);

      if Status = msOcupado then
      begin

        Brush.Color:=ActiveColor;

        if FOver then
        begin
           Pen.Color:=OverBorderColor;
           Brush.Color:=OverColor;
        end;

        //Brush.Style:=bsClear;
        FillRect(ClientRect);
        if Border then Rectangle(X, Y, X + W, Y + H);

        if Assigned(Picture.Graphic) then
        begin
         Picture.Graphic.Transparent:=true;
         Draw(0,0,Picture.Graphic);
        end;

        Hint:='Место: '+Puesto+chr(13)+'Клиент: '+Text+chr(13)+'Ном. Машины: '
               +Placa+chr(13) +'Статус: Занято';

        ShowHint:=true;

        Flags:=AAlignment[_BiDiMode(Alignment,BiDiMode)] or DT_NOPREFIX or DT_END_ELLIPSIS;
        Font:=self.Font;
        R:=Rect(despv,despv,width-despv,TextHeight(Placa)+despv);
        Drawtext(handle,PChar(Placa),-1,R,flags);

        Flags:=AAlignment[_BiDiMode(FPuestoFontAlign,BiDiMode)] or DT_NOPREFIX or DT_END_ELLIPSIS;
        Font:=self.FPuestoFont;
        R:=Rect(despv,(Height div 2)-(TextHeight(caption) div 2), Width-despv, (Height div 2)+(TextHeight(caption) div 2));
        DrawText(Handle, PChar(caption), -1, R, Flags);

        Flags:=AAlignment[_BiDiMode(TextAlign,BiDiMode)] or DT_NOPREFIX or DT_END_ELLIPSIS;
        Font:=self.TextFont;
        R:=Rect(despv,height-despv-TextHeight(Text),width-despv,height-despv);
        DrawText(Handle, PChar(Text), -1, R, Flags);

      end else begin
        texto:='Место: '+Puesto+chr(13)+'Статус: Свободно';
        Hint:=Texto;

        Placa:=EmptyStr;
        Text:=EmptyStr;
        FDataInicio:=-693594;

        Flags:=AAlignment[_BiDiMode(FPuestoFontAlign,BiDiMode)] or DT_NOPREFIX or DT_END_ELLIPSIS;
        Font:=self.FPuestoFont;
        R:=Rect(despv,(Height div 2)-(TextHeight(caption) div 2), Width-despv, (Height div 2)+(TextHeight(caption) div 2));
        DrawText(Handle, PChar(caption), -1, R, Flags);
      end;
   end;
end;


procedure Register;
begin
  RegisterComponents('Estacionamiento', [TPuesto]);
end;

end.

Al rescribir el componente he realizado varias lineas de código pero no se como hacer uso de las canvas en FMX.

unit FMX.TPuesto;

interface

uses
  System.Classes,
  System.UITypes,
  FMX.Types,
  FMX.Controls,
  FMX.Objects,
  FMX.Graphics;

const
  ColorOver = TAlphaColors.Gray;
  ColorOcupado = TAlphaColors.Red;
  ColorLibre = TAlphaColors.Gainsboro;

type
  TPuesto = class(TRectangle)
  private
    {Data}
    FId: Integer;
    FPlaca: String;
    FPuesto: String;
    FCliente: String;
    FStatus: Boolean;
    FPoints: TFPoint;

    {funciones y procedimientos relacionados con data}
    procedure setId(const Valor: Integer);
    procedure setPlaca(const Valor: String);
    procedure setPuesto(const Valor: String);
    procedure setCliente(const Valor: String);
    procedure setStatus(const Valor: boolean);

  protected
    procedure Paint; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property Dato1: Integer read Fid write setId default 0;
    property Dato2: String read FPlaca write setPlaca;
    property Dato3: String read FPuesto write setPuesto;
    property Dato4: String read FCliente write setCliente;
    Property Status: Boolean read FStatus write setStatus;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('JairoRamos', [TPuesto]);
end;

{ TBado }

constructor TPuesto.Create(AOwner: TComponent);
begin
  inherited;
  Fid:= 0;
  FPlaca:= 'Placa del Vehiculo';
  Fpuesto:= 'Numero del Puesto';
  FCliente:= 'Cliente';
  FStatus := false;
  length(FPoints,4);
  TabStop:= true;
end;

destructor TPuesto.Destroy;
begin
  //inherited;
end;

procedure TPuesto.paint;
var
  R : TrectR
begin
  inherited paint;

  R := GetShapeRect;

  FPoints[0] := PointF(R.Left, R.Bottom);
  FPoints[1] := PointF(R.Right, R.Bottom);
  FPoints[2] := PointF(R.Right, R.Top);
  FPoints[3] := PointF(R.Left, R.top);
  FPoints[4] := PointF(R.Left, R.Bottom);

  if FStatus then
    canvas.Fill.Color:= ColorOcupado
  else
    canvas.Fill.Color:= ColorLibre;

  Canvas.FillPolygon(FPoints, AbsoluteOpacity);
  Canvas.Stroke.Kind:= tbrushkind.Solid;
  canvas.Stroke.Thickness:= 1;
  canvas.Stroke.Color:= talphacolors.Black;
  Canvas.DrawPolygon(FPoints, AbsoluteOpacity);

end;

Pues esta es la maqueta de los que he dejado de tanto borrar y editar. el problema principal es que cuando pinto el fondo o re-dimensiono el componente solamente lo hace en tiempo de diseno ya que en ejecución no lo hacer. Se que es un componente sencillo pero realmente es primera vez que intento hacer algún componente en FMX y no doy pie con bolas, ya que la documentación al respecto es algo ambigua. realmente necesito de su ayuda aunque sea en su forma mas simple.

Vista general del programa.

1 respuesta 1

1

Bueno creo que la pregunta estuvo mal planteada o no fue interesante, aca les dejo la solución que pude realizar.

unit FMX.TPuesto;

interface

uses
  System.Classes,
  System.UITypes,
  FMX.Types,
  FMX.Controls,
  FMX.Objects,
  FMX.Graphics,
  System.SysUtils, FMX.Textos;

const
  ColorOver = TAlphaColors.Gray;
  ColorOcupado = TAlphaColors.Red;
  ColorLibre = TAlphaColors.Gainsboro;

type
  TPuesto = class(TShape)
  private
    {Data}
    FId: Integer;
    FPlaca: String;
    FPuesto: String;
    FCliente: String;
    FStatus: Boolean;
    FOver: boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    procedure setId(const Valor: Integer);
    procedure setPlaca(const Valor: String);
    procedure setPuesto(const Valor: String);
    procedure setCliente(const Valor: String);
    procedure setStatus(const Valor: boolean);
    function FormatoPlaca(const texto : String):String;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoMouseLeave; override;
    procedure DoMouseEnter; override;
  published
    property ShowHint;
    property DatoId: Integer read Fid write setId default 0;
    property DatoPlaca: String read FPlaca write setPlaca;
    property DatoPuesto: String read FPuesto write setPuesto;
    property DatoCliente: String read FCliente write setCliente;
    Property DatoStatus: Boolean read FStatus write setStatus;
    property Fill;
    property Stroke;
    property Width;
    property Height;
    property Size;
    property Scale;
    property Hint;
    property HitTest;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;    
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;    
    property OnClick;
    property OnDblClick;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;    
    property OnPainting;
    property OnPaint;
    property OnResize;
    property OnResized;
  end;

procedure Register;

implementation

uses
  System.Math, System.Types;

procedure Register;
begin
  RegisterComponents('Usuario', [TPuesto]);
end;

constructor TPuesto.Create(AOwner: TComponent);
begin
  inherited;
  Fid:= 0;
  FPlaca:= EmpTyStr;
  Fpuesto:= EmpTyStr;
  FCliente:= EmpTyStr;
  FStatus := false;
  HitTest:= true;
  ShowHint:= true;
  Hint:= EmpTyStr;
  FOver:= false;
  TabStop:= true;
  TabOrder:= FId;
end;

destructor TPuesto.Destroy;
begin
  inherited;
end;

procedure TPuesto.DoMouseEnter;
begin
  inherited;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(self);
  FOver:= true;
  repaint;
end;

procedure TPuesto.DoMouseLeave;
begin
  inherited;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(self);
  FOver:= false;
  repaint;
end;

function TPuesto.FormatoPlaca(const texto: String): String;
var msg:String;
begin
  msg := AnsiUpperCase(texto);
  if (length(msg)>=8) and (length(msg)<=11)  then
    Result:= Format('%s-%s-%s-%s',
           [Copy(msg, 1, 1), Copy(msg, 2, 3), Copy(msg, 5, 2),
           Copy(msg, 7, MaxInt)])
  else
    result := texto;
end;

procedure TPuesto.Paint;
var
  Fuente: TFont;
  tmp: TSizeF;
  MyRect: TRectF;
begin
  inherited;
  Canvas.BeginScene;
    if (FOver or IsFocused) then
      canvas.Fill.Color:= ColorOver
    else
      if FStatus then
        canvas.Fill.Color:= ColorOcupado
      else
        canvas.Fill.Color:= ColorLibre;
    MyRect := TRectF.Create(0, 0, Width, Height);
    Canvas.FillRect(MyRect, 0, 0, AllCorners, 100);
  Canvas.EndScene;

  Canvas.BeginScene;
    Canvas.Stroke.Thickness:= 1;
    Canvas.Stroke.Color:= TAlphaColors.Black;
    Canvas.Stroke.Dash:= TStrokeDash.Solid;
    MyRect := TRectF.Create(Canvas.Stroke.Thickness/2, Canvas.Stroke.Thickness/2,
      Width-(Canvas.Stroke.Thickness/2), Height-(Canvas.Stroke.Thickness/2));
    Canvas.DrawRect(MyRect, 0, 0, AllCorners, 100);
  Canvas.EndScene;

  try
      Canvas.BeginScene;
      Fuente:= TFont.Create;
      with Fuente do
      begin
        Size:=11;
        Family:= 'Tahoma';
        Style:= [TFontStyle.fsBold];
      end;
      Canvas.Font.Assign(Fuente);
      Canvas.Fill.Color := TAlphaColorRec.Navy;
      tmp:= CalcTextSize(FPuesto,Fuente,Fuente.Size);
      Canvas.FillText(RectF((Width-tmp.Width)/2, (Height-tmp.Height)/2,
        (Width+tmp.Width)/2,(Height+tmp.Height)/2), FPuesto , False, 1, [], TTextAlign.Center, TTextAlign.Center);
      Canvas.EndScene;

      Hint:='Puesto: ' + FPuesto + chr(13) +
            'Estatus: Libre';

    if FStatus then
    begin
      Canvas.BeginScene;
      with Fuente do
      begin
        Size:=8;
        Family:= 'Arial';
      end;
      Canvas.Font.Assign(Fuente);
      Canvas.Fill.Color := TAlphaColorRec.Black;
      tmp:= CalcTextSize(FPlaca,Fuente,Fuente.Size);
      Canvas.FillText(RectF((Width-tmp.Width)/2,5,
        (Width+tmp.Width)/2,tmp.Height+5), FPlaca , False, 1, [], TTextAlign.Center, TTextAlign.Center);
      Canvas.EndScene;

      Fuente:= TFont.Create;
      Canvas.BeginScene;
      with Fuente do
      begin
        Size:=9;
        Family:= 'Tahona';
      end;
      Canvas.Font.Assign(Fuente);
      Canvas.Fill.Color := TAlphaColorRec.Black;
      tmp:= CalcTextSize(FCliente,Fuente,Fuente.Size);
      Canvas.FillText(RectF((Width-tmp.Width)/2,Height-(tmp.Height)- 5,
        (Width+tmp.Width)/2,Height-5), FCliente, False, 1, [], TTextAlign.Center, TTextAlign.Center);
      Canvas.EndScene;

      Hint:='Puesto: ' + FPuesto + chr(13) +
            'Cliente: ' + FCliente + chr(13) +
            'Placa: ' + FPlaca + chr(13) +
            'Estatus: Ocupado';
    end;

  Finally
    if Assigned(Fuente) then
      freeAndNil(Fuente);
  end
end;

procedure TPuesto.setCliente(const Valor: String);
begin
  if FCliente<>Valor then
  begin
    FCliente:= Valor;
    repaint;
  end;
end;

procedure TPuesto.setId(const Valor: Integer);
begin
  if FId<>Valor then
  begin
    FId:= Valor;
    repaint;
  end;
end;

procedure TPuesto.setPlaca(const Valor: String);
begin
  if FPlaca<>Valor then
  begin
    FPlaca := FormatoPlaca(Valor);
    repaint;
  end;
end;

procedure TPuesto.setPuesto(const Valor: String);
begin
  if FPuesto<>Valor then
  begin
    Fpuesto:= Valor;
    repaint;
  end;
end;

procedure TPuesto.setStatus(const Valor: boolean);
begin
  if FStatus<> Valor then
  begin
    FStatus:= Valor;
    repaint;
  end;
end;

end.
1
  • Seguro que es interesante, pero no creo que haya mucha gente con conocimiento sobre esta tecnología, agregale un pequeño contexto a la respuesta y explicanos qué cambiaste para que funcionara y marca tu respuesta como aceptada :D
    – NaCl
    Commented el 14 may. 2018 a las 12:38

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.