Code:
{==============================================================================
Naam component : LzPanelGrids
Maker :
Copyright (c) : Free ware
Versie : 01
Datum : 20-07-2019
Doel :
Componenten palet : LzWindows 10
Component : Delphi en Lazarus
Naam .PNG-bestand : TLzPanelGrids.PNG (Lazarus)
Naam .LRS-bestand : LzPanelGrids_icon.lrs (Lazarus)
Historie : Datum Omschrijving
---------- ------------------------------------------------
20-07-2019 Start ontwikkeling component
TStringGrid
|
+--- TLzPanelGrids
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 Lzgridpanels;
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
INTERFACE
USES
{$IFNDEF FPC}
Windows,
{$ELSE}
LCLIntf,
LCLType,
LResources,
{$ENDIF}
Classes,
Controls,
Dialogs,
ExtCtrls, Forms,
Graphics,
Grids,
StdCtrls,
SysUtils,
Variants;
TYPE
TLzPanelGrids = CLASS;
TColumnItem = CLASS(TCollectionItem)
private
FText: string;
FControl: TControl;
FColumn: integer;
FColumnSpan: integer;
FRow: integer;
FRowSpan: integer;
FUNCTION GetDisplayName: string; override;
PROCEDURE SetText(CONST Value: string);
PROCEDURE SetControl(CONST aControl: TControl);
PROCEDURE SetColumnSpan(Value: integer);
PROCEDURE SetColumn(Value: integer);
PROCEDURE SetRowSpan(Value: integer);
PROCEDURE SetRow(Value: 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 Row: integer read FRow write SetRow;
PROPERTY RowSpan: integer read FRowSpan write SetRowSpan;
PROPERTY Index;
END;
TColumnCollection = CLASS(TCollection)
private
FLzPanelGrids: TLzPanelGrids;
FUNCTION GetItem(Index: integer): TColumnItem;
PROCEDURE SetItem(Index: integer; AValue: TColumnItem);
protected
FUNCTION GetOwner: TPersistent; override;
public
CONSTRUCTOR Create(LzPanelGrids: TLzPanelGrids);
FUNCTION Add: TColumnItem;
PROPERTY Items[Index: integer]: TColumnItem read GetItem write SetItem; //default;
END;
TLzPanelGrids = CLASS(TCustomStringGrid)
private { Private declarations }
FColumnCollection: TColumnCollection;
FCol: integer;
FRow: integer;
FCellNr: boolean;
FCellRaster: boolean;
Sw : Boolean;
// True dan wordt raster weergegeven bij Run van het programma
// Default = False;
PROCEDURE SetCol(Value: integer);
PROCEDURE SetRow(Value: integer);
PROCEDURE SetCellNr(Value: boolean);
protected { Protected declarations }
public { Public declarations }
CONSTRUCTOR Create(AOwner: TComponent); override;
DESTRUCTOR Destroy; override;
PROCEDURE Paint; override;
PROCEDURE SetDrawCell(Sender: TObject; aCol, aRow: integer;
aRect: TRect; aState: TGridDrawState);
published { Published declarations }
PROPERTY Hint;
PROPERTY ShowHint;
PROPERTY Tag;
PROPERTY Align;
PROPERTY Color;
PROPERTY Col: integer read FCol write SetCol;
PROPERTY Row: integer read FRow write SetRow;
PROPERTY ColumnCollection: TColumnCollection
read FColumnCollection write FColumnCollection;
PROPERTY CellNr: boolean read FCellNr write SetCellNr;
PROPERTY CellRaster: boolean read FCellRaster write FCellRaster;
END;
PROCEDURE Register;
IMPLEMENTATION
var
tel : integer;
ColArr : Array[0..25] of Integer;
Totaal_Ingesteld : Double;
Perc : Double;
{==============================================================================
Procedure : Register
Maker :
Datum : 20-07-2019
Argument :
Resultaat :
Doel : Registreren van de component
==============================================================================}
PROCEDURE Register;
BEGIN
{$I LzPanelGrids_icon.lrs}
RegisterComponents('LzWindows 10', [TLzPanelGrids]);
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
BEGIN
IF Value < 1 THEN
Value := 1;
FColumnSpan := Value;
END;
END;
PROCEDURE TColumnItem.SetColumn(Value: integer);
BEGIN
IF FColumn <> Value THEN
BEGIN
FColumn := Value;
END;
END;
PROCEDURE TColumnItem.SetRowSpan(Value: integer);
BEGIN
IF FRowSpan <> Value THEN
BEGIN
IF Value < 1 THEN
Value := 1;
FRowSpan := Value;
END;
END;
PROCEDURE TColumnItem.SetRow(Value: integer);
BEGIN
IF FRow <> Value THEN
BEGIN
FRow := Value;
END;
END;
// =============================================================================
{TColumnCollection}
CONSTRUCTOR TColumnCollection.Create(LzPanelGrids: TLzPanelGrids);
BEGIN
INHERITED Create(TColumnItem);
FLzPanelGrids := LzPanelGrids;
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 := FLzPanelGrids;
END;
{==============================================================================
Procedure : Create
Maker :
Datum : 20-07-2019
Argument : Sender: TObject
Resultaat : Geen
Doel : Initiatie van de component
==============================================================================}
CONSTRUCTOR TLzPanelGrids.Create(AOwner: TComponent);
VAR
C, R: integer;
BEGIN
INHERITED Create(AOwner);
Height := 50;
Width := 200;
FixedCols := 0;
FixedRows := 0;
ScrollBars := ssNone;
OnDrawCell := SetDrawCell;
ColCount := 2;
RowCount := 2;
FCol := 2;
FRow := 2;
FColumnCollection := TColumnCollection.Create(nil);
SetCellNr(False);
Color := clWhite;
FCellRaster := False;
BorderStyle := bsNone;
END;
{==============================================================================
Procedure : Destroy
Maker :
Datum : 20-07-2019
Argument : Geen
Resultaat : Geen
Doel :
==============================================================================}
DESTRUCTOR TLzPanelGrids.Destroy;
BEGIN
FColumnCollection.Free;
INHERITED Destroy;
END;
{==============================================================================
Procedure : Paint
Maker :
Datum : 20-07-2019
Argument : Geen
Resultaat : Geen
Doel : Tekenen component
==============================================================================}
PROCEDURE TLzPanelGrids.Paint;
VAR
aRect: TRect;
aState: TGridDrawState;
I,C, R: integer;
BEGIN
INHERITED Paint;
AState := [gdSelected];
ARect := Rect(0, 0, 0, 0);
FOR C := 0 TO ColCount - 1 DO
BEGIN
ColWidths[C] := Width div ColCount;
END;
FOR R := 0 TO RowCount - 1 DO
BEGIN
RowHeights[R] := Height div RowCount;
END;
IF (csDesigning in ComponentState) THEN
ELSE
IF FCellNr = True THEN
SetCellNr(False);
IF (csDesigning in ComponentState) THEN
SetDrawCell(Self, 0, 0, aRect, aState);
END;
{******************************************************************************}
PROCEDURE TLzPanelGrids.SetDrawCell(Sender: TObject; aCol, aRow: integer;
aRect: TRect; aState: TGridDrawState);
VAR
I: integer;
Col, Row: integer;
BEGIN
INHERITED;
IF csDesigning in ComponentState THEN
BEGIN
FOR I := 0 TO ColumnCollection.Count - 1 DO
BEGIN
IF ColumnCollection.Items[I].ColumnSpan < 1 THEN
ColumnCollection.Items[I].ColumnSpan := 1;
IF ColumnCollection.Items[I].RowSpan < 1 THEN
ColumnCollection.Items[I].RowSpan := 1;
Col := ColumnCollection.Items[I].Column;
Row := ColumnCollection.Items[I].Row;
FOR ACol := 0 TO ColCount - 1 DO
BEGIN
FOR ARow := 0 TO RowCount - 1 DO
BEGIN
IF (ACol = Col) and (ARow = Row) and
(Assigned(ColumnCollection.Items[I].Control)) THEN
WITH ColumnCollection.Items[I].Control DO
BEGIN
Parent := Self;
ARect := CellRect(ACol, ARow);
Left := aRect.Left;
Top := aRect.Top;
Width := (aRect.Right - Left) * ColumnCollection.Items[I].ColumnSpan;
Height := (aRect.Bottom - Top) * ColumnCollection.Items[I].RowSpan;
END;
END;
END;
END;
Exit;
END;
IF FCellRaster = False THEN
Options := Options - [goHorzLine, goVertLine];
FocusRectVisible := False;
FOR I := 0 TO ColumnCollection.Count - 1 DO
BEGIN
IF ColumnCollection.Items[I].ColumnSpan < 1 THEN
ColumnCollection.Items[I].ColumnSpan := 1;
IF ColumnCollection.Items[I].RowSpan < 1 THEN
ColumnCollection.Items[I].RowSpan := 1;
Col := ColumnCollection.Items[I].Column;
Row := ColumnCollection.Items[I].Row;
IF (ACol = Col) and (ARow = Row) and
(Assigned(ColumnCollection.Items[I].Control)) THEN
WITH ColumnCollection.Items[I].Control DO
BEGIN
Parent := Self;
Left := aRect.Left;
Top := aRect.Top;
Width := ColWidths[aCol] * ColumnCollection.Items[I].ColumnSpan;
Height := RowHeights[aRow] * ColumnCollection.Items[I].RowSpan;
END;
END;
END;
PROCEDURE TLzPanelGrids.SetCol(Value: integer);
VAR
C, R: integer;
BEGIN
IF FCol <> Value THEN
BEGIN
FCol := Value;
ColCount := FCol;
SetCellNr(False);
Sw:=False;
Refresh;
//Invalidate;
END;
END;
PROCEDURE TLzPanelGrids.SetRow(Value: integer);
VAR
C, R: integer;
BEGIN
IF FRow <> Value THEN
BEGIN
FRow := Value;
RowCount := FRow;
SetCellNr(False);
Invalidate;
END;
END;
PROCEDURE TLzPanelGrids.SetCellNr(Value: boolean);
VAR
C, R: integer;
BEGIN
IF FCellNr <> Value THEN
BEGIN
FCellNr := Value;
IF FCellNr = False THEN
BEGIN
FOR C := 0 TO ColCount - 1 DO
BEGIN
FOR R := 0 TO RowCount - 1 DO
BEGIN
Cells[C, R] := '';
END;
END;
END;
IF (csDesigning in ComponentState) and (FCellNr = True) THEN
BEGIN
FOR C := 0 TO ColCount - 1 DO
BEGIN
FOR R := 0 TO RowCount - 1 DO
BEGIN
Cells[C, R] := IntToStr(C) + ', ' + IntToStr(R);
END;
END;
END;
Invalidate;
END;
END;
INITIALIZATION
//RegisterClass(T...)
END.
Bookmarks