Fórum Ajuda com grid personalizado #615412
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?
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
Curtir tópico
+ 0
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
Gostei + 0
Clique aqui para fazer login e interagir na Comunidade :)