Ajuda com grid personalizado

31/03/2021

0

Boa Tarde,

Estou criando um grid personalizado pra mim, criei ele com o TDPDBGrid = class(TScrollingWinControl), e fiz a inclusão de um TCanvas, onde estou enviando os componentes.

Eu crio tento criar uma parte do componente da seguinte forma:

procedure TDPDBGrid.Paint;
var
li, vHorz, lTop : integer;
begin
vHorz := HorzScrollBar.Position;

FCanvas.Brush.Style := bsSolid;
FCanvas.Brush.Color := ClWhite;
FCanvas.FillRect(ClientRect);

FPanelColumns.Clear;


for li := 0 to FColumns.Count -1 do
begin

FPanelColumns.Add(FPanelColumn);

TFlowPanel(FPanelColumns[li]).Parent := Self;

TFlowPanel(FPanelColumns[li]).Align := alLeft;

TFlowPanel(FPanelColumns[li]).Caption:= IntToStr(FPanelColumns.Count) + ' - ' + FColumns[li].Caption;


end;

end;

O evento que escolhi foi o Paint, mas não sei se é o correto, e quando estou tentando usar ele cria sempre a ultima coluna, como se a instancia do mesmo subscrevesse a da primeira coluna.

Eu estou no caminho, ou totalmente errado, como eu resolvo o problema de não criar os paineis?
Edemar Polli

Edemar Polli

Responder

Posts

31/03/2021

Edemar Polli

Código todo:

unit DPDBGrid;

interface

uses
  Forms, Graphics, Messages, Windows, Controls, Classes, Vcl.ExtCtrls, SysUtils;

type
  TDPDBGridConst = class
  const
    MARGEM_TOP = 3 ;      // Margem superior da legenda
    LEFT_RET = 3;         // Posição esquerda do retangulo de cor da legenda
    RIGHT_RET = 33;       // Posição direita do retangulo de cor da legenda
    HEIGHT_RET = 13;      // Altura do retangulo de cor da legenda
    LEFT_TEXT = 4;        // Posição esquerda do Texto da legenda
    HEIGHT_LINHA = 18;    // Tamanho da altura das linhas
  end;

  TDPDBGrid = class;

TDPDBGridColumn = class(TCollectionItem)
  private
    FColor: TColor;
    FCaption: TCaption;
    procedure SetCaption(const Value: TCaption);
    procedure SetColor(const Value: TColor);
  published
    property Color : TColor read FColor write SetColor;
    property Caption : TCaption read FCaption write SetCaption;
  end;

TDPDBGridColumns = class(TCollection)
    FMukaLegenda : TDPDBGrid;
    function GetItem(Index: Integer): TDPDBGridColumn;
    procedure SetItem(Index: Integer; Value: TDPDBGridColumn);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(pCompLegenda: TDPDBGrid);
    function Add: TDPDBGridColumn;
    property Items[Index: Integer]: TDPDBGridColumn read GetItem write SetItem; default;
  end;

TDPDBGrid = class(TScrollingWinControl)
  private
    FCanvas: TCanvas;
    FColumns: TDPDBGridColumns;
    FPanelColumn : TPanel;
    FPanelColumns: TList;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PaintWindow(DC: HDC); override;
    procedure Paint; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
  published
    property Columns: TDPDBGridColumns read FColumns write FColumns;
    property Color;
  end;

  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DataPro Controls',[TDPDBGrid]);
end;

{ TDPDBGrid }

constructor TDPDBGrid.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;

  DoubleBuffered := True;

  FColumns            := TDPDBGridColumns.Create(Self);
  FPanelColumn        := TPanel.Create(Self);
  FPanelColumns       := TList.Create;

end;

procedure TDPDBGrid.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_BORDER;
end;

destructor TDPDBGrid.Destroy;
begin
  FCanvas.Free;
  FColumns.Free;
  FPanelColumn.Free;
  inherited;
end;

procedure TDPDBGrid.Paint;
var
  li, vHorz, lTop : integer;
begin
  vHorz := HorzScrollBar.Position;

  FCanvas.Brush.Style := bsSolid;
  FCanvas.Brush.Color := ClWhite;
  FCanvas.FillRect(ClientRect);

  FPanelColumns.Clear;


  for li := 0 to FColumns.Count -1 do
  begin

      FPanelColumns.Add(FPanelColumn);

      TPanel(FPanelColumns[li]).Parent  := Self;

      TPanel(FPanelColumns[li]).Align   := alLeft;

      TPanel(FPanelColumns[li]).Caption:= IntToStr(FPanelColumns.Count) + ' - ' + FColumns[li].Caption;
  end;

end;

procedure TDPDBGrid.PaintWindow(DC: HDC);
begin
  inherited;
  FCanvas.Lock;
  try
    FCanvas.Handle := DC;
    try
      TControlCanvas(FCanvas).UpdateTextFlags;
      Paint;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

procedure TDPDBGrid.WMNCHitTest(var Message: TWMNCHitTest);
begin
  DefaultHandler(Message);
end;

procedure TDPDBGrid.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;

{ TLegendaItem }

procedure TDPDBGridColumn.SetCaption(const Value: TCaption);
begin
  FCaption := Value;
  Changed(False);
end;

procedure TDPDBGridColumn.SetColor(const Value: TColor);
begin
  FColor := Value;
  Changed(False);
end;

{ TLegendas }

function TDPDBGridColumns.Add: TDPDBGridColumn;
begin
  Result := TDPDBGridColumn(inherited Add);
end;

constructor TDPDBGridColumns.Create(pCompLegenda: TDPDBGrid);
begin
  inherited Create(TDPDBGridColumn);
  FMukaLegenda := pCompLegenda;
end;

function TDPDBGridColumns.GetItem(Index: Integer): TDPDBGridColumn;
begin
  Result := TDPDBGridColumn(inherited GetItem(Index));
end;

function TDPDBGridColumns.GetOwner: TPersistent;
begin
  Result := FMukaLegenda;
end;

procedure TDPDBGridColumns.SetItem(Index: Integer; Value: TDPDBGridColumn);
begin
  inherited SetItem(Index, Value);
end;

procedure TDPDBGridColumns.Update(Item: TCollectionItem);
var
  iCols : integer;
begin
  inherited;
  iCols := FMukaLegenda.Columns.Count;
  FMukaLegenda.HorzScrollBar.Range := (iCols * TDPDBGridConst.HEIGHT_LINHA) + TDPDBGridConst.MARGEM_TOP;
  FMukaLegenda.Invalidate;
end;

end.
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