Propriedade componente não grava

09/05/2022

0

Estou criando um componente baseado em TDBGrid, incrementando algumas funcionalidades, por exemplo, para zebrar, porém, mesmo eu ativando TRUE na propriedade ZEBRAR, ele aparece FALSE quando passa pelo código debugando, e a opção escolhida para a propriedade não fica salvo no projeto também, como se não estivesse indo para o ".dfm", sendo assim, ao abrir o projeto, a propriedade esta FALSE novamente. (ao fechar o projeto o delphi trava também). Alguém pode me dar uma dica onde estou errando? Já procurei na internet e não consigo encontrar a solução. Grato. Segue a implementação:
unit MZDBGrid;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.Grids, Vcl.DBGrids, Vcl.Graphics, System.Types;

type
  TBloqueios = (blqInsert, blqDelete);
  TBloqueio = set of TBloqueios;

  TCorZebra = class
  private
    FZebrar: Boolean;
    FCorPrimaria: TColor;
    FCorSecundaria: TColor;
  public
    constructor Create;  
  published
    property Zebrar: Boolean read FZebrar write FZebrar default False;
    property CorPrimaria: TColor read FCorPrimaria write FCorPrimaria default clWindow;
    property CorSecundaria: TColor read FCorSecundaria write FCorSecundaria default clSilver;
  end;

  TMZDBGrid = class(Vcl.DBGrids.TDBGrid)
  private
    FCorZebra: TCorZebra;
    FBloqueio: TBloqueio;  
    procedure SetCorZebra(Value: TCorZebra);
  protected   
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property CorZebra: TCorZebra read FCorZebra write SetCorZebra stored True; // NAO FICA GRAVADO NO PROJETO
    property Bloqueio: TBloqueio read FBloqueio write FBloqueio stored True; // NAO FICA GRAVADO NO PROJETO
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MZComponents', [TMZDBGrid]);
end;

{ TMZDBGrid }

constructor TMZDBGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCorZebra := TCorZebra.Create;
  FCorZebra.CorPrimaria := clWindow;
  FCorZebra.CorSecundaria := clSilver;
  Include(FBloqueio, blqInsert);
  Include(FBloqueio, blqDelete);
end;

destructor TMZDBGrid.Destroy;
begin
  FCorZebra.DisposeOf;
  inherited Destroy;
end;

procedure TMZDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  inherited;
  if FCorZebra.Zebrar then // MESMO COLOCANDO TRUE NO PROJETO, AO DEBUGAR CHEGA AQUI FALSE 
  begin
    if Odd(Self.DataSource.DataSet.RecNo) then
      Self.Canvas.Brush.Color := FCorZebra.CorPrimaria
    else
      Self.Canvas.Brush.Color := FCorZebra.CorSecundaria;

    Self.Canvas.FillRect(Rect);
    Self.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

procedure TMZDBGrid.SetCorZebra(Value: TCorZebra);
begin
  if Assigned(FCorZebra) then
    FCorZebra := Value;
end;

{ TCorZebra }

constructor TCorZebra.Create;
begin
  FZebrar := False;
  FCorPrimaria := clWindow;
  FCorSecundaria := clSilver;
end;

end.
Welinton Dias

Welinton Dias

Responder

Post mais votado

09/05/2022

tente isto:
unit MZDBGrid;

interface

uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.Grids, Vcl.DBGrids, Vcl.Graphics, System.Types;

type
  TBloqueios = (blqInsert, blqDelete);
  TBloqueio = set of TBloqueios;

{$M+}

  TCorZebra = class(TPersistent)
  private
    FZebrar: Boolean;
    FCorPrimaria: TColor;
    FCorSecundaria: TColor;
  public
    constructor Create;
  published
    property Zebrar: Boolean read FZebrar write FZebrar;
    property CorPrimaria: TColor read FCorPrimaria write FCorPrimaria;
    property CorSecundaria: TColor read FCorSecundaria write FCorSecundaria;
  end;

  TMZDBGrid = class(Vcl.DBGrids.TDBGrid)
  private
    FCorZebra: TCorZebra;
    FBloqueio: TBloqueio;
    procedure SetCorZebra(Value: TCorZebra);
    procedure SetBloqueio(const Value: TBloqueio);
  protected
    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property CorZebra: TCorZebra read FCorZebra write SetCorZebra;
    property Bloqueio: TBloqueio read FBloqueio write SetBloqueio;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MZComponents', [TMZDBGrid]);
end;

{ TMZDBGrid }

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

  FCorZebra := TCorZebra.Create;
  Include(FBloqueio, blqInsert);
  Include(FBloqueio, blqDelete);
end;

destructor TMZDBGrid.Destroy;
begin
  FCorZebra.DisposeOf;
  inherited Destroy;
end;

procedure TMZDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  inherited;
  if FCorZebra.Zebrar then // MESMO COLOCANDO TRUE NO PROJETO, AO DEBUGAR CHEGA AQUI FALSE
  begin
    if Odd(Self.DataSource.DataSet.RecNo) then
      Self.Canvas.Brush.Color := FCorZebra.CorPrimaria
    else
      Self.Canvas.Brush.Color := FCorZebra.CorSecundaria;

    Self.Canvas.FillRect(Rect);
    Self.DefaultDrawColumnCell(Rect, DataCol, Column, State);
  end;
end;

procedure TMZDBGrid.SetBloqueio(const Value: TBloqueio);
begin
  FBloqueio := Value;
end;

procedure TMZDBGrid.SetCorZebra(Value: TCorZebra);
begin
  if Assigned(FCorZebra) then
    FCorZebra := Value;
end;

{ TCorZebra }

constructor TCorZebra.Create;
begin
  FZebrar := False;
  FCorPrimaria := clWindow;
  FCorSecundaria := clSilver;

  inherited;
end;

end.

Emerson Nascimento

Emerson Nascimento
Responder

Mais Posts

09/05/2022

Welinton Dias

Perfeito, funcionou certinho agora.
Estou começando agora a me aventurar em criação de componente, sendo assim, desconheço alguns detalhes. Irei estudar as alterações que você fez, para entender meu erro.
Muito obrigado, sucessos pra vc sempre.
Responder

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar