Code:
{==============================================================================
Naam component : lzpnlgrid
Maker :
Copyright (c) : Free ware
Versie : 01
Datum : 07-07-2019
Doel :
Componenten palet : LzWindows 10
Component : Delphi en Lazarus
Naam .PNG-bestand : TLzPanelGrid.PNG (Lazarus)
Naam .LRS-bestand : LzPanelGrid_icon.lrs (Lazarus)
Historie : Datum Omschrijving
---------- ------------------------------------------------
07-07-2019 Start ontwikkeling component
TStringGrid
|
+--- TLzPanelGrid
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to
deal in the Software without restriction, including without limitation the
rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
IN THE SOFTWARE.
==============================================================================}
UNIT lzpnlgrid;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
INTERFACE
USES
{$IFNDEF FPC}
Windows,
{$ELSE}
LCLIntf,
LCLType,
LMessages,
LResources,
{$ENDIF}
Classes,
Controls,
Dialogs,
ExtCtrls, Forms,
Graphics,
Grids,
Messages,
StdCtrls,
SysUtils,
Variants;
TYPE
// ColunmCollection
TLzPanelGrid = Class;
TColumnItem = class(TCollectionItem)
private
FText: string;
FControl: TControl;
FColumn : Integer;
FColumnSpan : Integer;
FValue : Integer;
function GetDisplayName: string; override;
procedure SetText(const Value: string);
procedure SetControl(const aControl: TControl);
procedure SetColumnSpan(Value : Integer);
procedure SetColumn(Value : Integer);
procedure SetValue(aValue : Integer);
public
published
property Text: string read FText write SetText;
property Control: TControl read FControl write SetControl;
property Column : Integer read FColumn write SetColumn;
property ColumnSpan : Integer read FColumnSpan write SetColumnSpan;
property Value : Integer read FValue write SetValue;
property Index;
end;
TColumnCollection = class(TCollection)
private
FLzPanelGrid: TLzPanelGrid;
function GetItem(Index: Integer): TColumnItem;
procedure SetItem(Index: Integer; AValue: TColumnItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(LzPanelGrid: TLzPanelGrid);
function Add: TColumnItem;
property Items[Index: Integer]: TColumnItem
read GetItem write SetItem; //default;
end;
//
// =============================================================================
//
{RowCollection}
TRowItem = class(TCollectionItem)
private
FText: string;
FControl: TControl;
FRow : Integer;
FRowSpan : Integer;
FValue : Integer;
function GetDisplayName: string; override;
procedure SetText(const Value: string);
procedure SetControl(const aControl: TControl);
procedure SetRowSpan(Value : Integer);
procedure SetRow(Value : Integer);
procedure SetValue(aValue : Integer);
public
published
property Text: string read FText write SetText;
property Control: TControl read FControl write SetControl;
property Index;
property Row : Integer read FRow write SetRow;
property RowSpan : Integer read FRowSpan write SetRowSpan;
property Value : Integer read FValue write SetValue;
end;
TRowCollection = class(TCollection)
private
FLzPanelGrid: TLzPanelGrid;
function GetItem(Index: Integer): TRowItem;
procedure SetItem(Index: Integer; AValue: TRowItem);
protected
function GetOwner: TPersistent; override;
public
constructor Create(LzPanelGrid: TLzPanelGrid);
function Add: TRowItem;
property Items[Index: Integer]: TRowItem
read GetItem write SetItem; default;
end;
//
// =============================================================================
//
{Component LzPanelGrid}
TLzPanelGrid = CLASS(TStringGrid)//Panel)
private { Private declarations }
FColumnCollection : TColumnCollection;
FRowCollection : TRowCollection;
procedure SetColumnCollection(Value : TColumnCollection);
procedure SetRowCollection(Value : TRowCollection);
procedure SetDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
protected { Protected declarations }
public { Public declarations }
CONSTRUCTOR Create(AOwner: TComponent); override;
DESTRUCTOR Destroy; override;
PROCEDURE Paint; override;
published { Published declarations }
PROPERTY Hint;
PROPERTY ShowHint;
PROPERTY Tag;
property Align;
property ColumnCollection: TColumnCollection read FColumnCollection write SetColumnCollection;
property RowCollection: TRowCollection read FRowCollection write SetRowCollection;
END;
PROCEDURE Register;
IMPLEMENTATION
PROCEDURE Register;
BEGIN
{$IFDEF FPC}
// Verwijder "//" in onderstaande regel als dit bestand is gemaakt
//{$I LzPanelGrid_icon.lrs}
{$ENDIF}
RegisterComponents('LzWindows 10', [TLzPanelGrid]);
END;
//
// =============================================================================
//
{TColumnCollection}
function TColumnItem.GetDisplayName: string;
begin
Result := Text;
if Result ='' then Result := inherited GetDisplayName;
end;
procedure TColumnItem.SetText(const Value: string);
begin
if FText <> Value then
FText := Value;
end;
procedure TColumnItem.SetControl(const aControl: TControl);
begin
if FControl = aControl then Exit;
Assert(FControl = nil);
FControl := aControl;
end;
procedure TColumnItem.SetColumnSpan(Value : Integer);
begin
If FColumnSpan <> Value then FColumnSpan := Value;
end;
procedure TColumnItem.SetColumn(Value : Integer);
begin
If FColumn <> Value then FColumn := Value;
end;
procedure TColumnItem.SetValue(aValue : Integer);
begin
If FValue <> AValue then FValue := AValue;
end;
//
// =============================================================================
//
{TColumnCollection}
constructor TColumnCollection.Create(LzPanelGrid: TLzPanelGrid);
begin
inherited Create(TColumnItem);
FLzPanelGrid := LzPanelGrid;
end;
function TColumnCollection.Add: TColumnItem;
begin
Result := TColumnItem(inherited Add);
end;
function TColumnCollection.GetItem(Index: Integer): TColumnItem;
begin
Result := TColumnItem(inherited GetItem(Index));
end;
procedure TColumnCollection.SetItem(Index: Integer;
AValue: TColumnItem);
begin
inherited SetItem(Index, AValue);
end;
function TColumnCollection.GetOwner: TPersistent;
begin
Result := FLzPanelGrid;
end;
//
// =============================================================================
//
{TRowItem}
function TRowItem.GetDisplayName: string;
begin
Result := Text;
if Result ='' then Result := inherited GetDisplayName;
end;
procedure TRowItem.SetText(const Value: string);
begin
if FText <> Value then
FText := Value;
end;
procedure TRowItem.SetControl(const aControl: TControl);
begin
if FControl = aControl then Exit;
Assert(FControl = nil);
FControl := aControl;
end;
procedure TRowItem.SetRowSpan(Value : Integer);
begin
If FRowSpan <> Value then FRowSpan := Value;
end;
procedure TRowItem.SetRow(Value : Integer);
begin
If FRow <> Value then FRow := Value;
end;
procedure TRowItem.SetValue(aValue : Integer);
begin
If FValue <> AValue then FValue := AValue;
end;
//
// =============================================================================
//
{TRowCollection}
constructor TRowCollection.Create(LzPanelGrid: TLzPanelGrid);
begin
inherited Create(TRowItem);
FLzPanelGrid := LzPanelGrid;
end;
function TRowCollection.Add: TRowItem;
begin
Result := TRowItem(inherited Add);
end;
function TRowCollection.GetItem(Index: Integer): TRowItem;
begin
Result := TRowItem(inherited GetItem(Index));
end;
procedure TRowCollection.SetItem(Index: Integer;
AValue: TRowItem);
begin
inherited SetItem(Index, AValue);
end;
function TRowCollection.GetOwner: TPersistent;
begin
Result := FLzPanelGrid;
end;
//
// =============================================================================
//
CONSTRUCTOR TLzPanelGrid.Create(AOwner: TComponent);
BEGIN
INHERITED;
FColumnCollection := TColumnCollection.Create(Self);
FRowCollection := TRowCollection.Create(Self);
FixedCols := 0;
FixedRows := 0;
ScrollBars := ssNone;
ColCount := 2;
RowCount := 2;
OnDrawCell := SetDrawCell;
//DefaultColWidth := 64;
//DefaultRowHeight := 22;
END;
DESTRUCTOR TLzPanelGrid.Destroy;
BEGIN
FColumnCollection.Free;
FRowCollection.Free;
INHERITED;
END;
procedure TLzPanelGrid.SetColumnCollection(Value : TColumnCollection);
begin
FColumnCollection.Assign(Value);
end;
procedure TLzPanelGrid.SetRowCollection(Value : TRowCollection);
begin
FRowCollection.Assign(Value);
end;
PROCEDURE TLzPanelGrid.Paint;
Var
C,R : Integer;
aRect: TRect; aState: TGridDrawState;
BEGIN
INHERITED;
If csDesigning In ComponentState Then SetDrawCell(nil,0,0,ARect,AState);
END;
procedure TLzPanelGrid.SetDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
Var
I : Integer;
Perc : Double;
Totaal_Ingesteld : Double;
begin
If ColumnCollection.Count > 2 then ColCount:= ColumnCollection.Count+1
else ColCount := 2;
Totaal_Ingesteld:=0;
For I := 0 to ColumnCollection.Count - 1 do
begin
Totaal_Ingesteld:= Totaal_Ingesteld + ColumnCollection.Items[I].FValue;
end;
If Totaal_Ingesteld = 0 then Totaal_Ingesteld := 1;
For I := 0 to ColumnCollection.Count - 1 do
begin
Perc := (ColumnCollection.Items[I].FValue / Totaal_Ingesteld) * 100;
Perc := Perc / 100;
ColWidths[I]:=Round(Width * Perc);
end;
If RowCollection.Count > 2 then RowCount:= RowCollection.Count+1;
Totaal_Ingesteld:=0;
For I := 0 to RowCollection.Count - 1 do
begin
Totaal_Ingesteld:= Totaal_Ingesteld + RowCollection.Items[I].FValue;
end;
If Totaal_Ingesteld = 0 then Totaal_Ingesteld := 1;
For I := 0 to RowCollection.Count - 1 do
begin
Perc := (RowCollection.Items[I].FValue / Totaal_Ingesteld) * 100;
Perc := Perc / 100;
RowHeights[I]:=Round(Height * Perc);
end;
end;
End.
Bookmarks