Results 1 to 3 of 3

Thread: CollectionItem in Lazarus geeft een AV

  1. #1

    CollectionItem in Lazarus geeft een AV

    Hallo allemaal,

    Zet op het Form LzPanelGrids1 en een Panel1.
    Open ColumnCollection en zet Control = Panel1.

    Panel1 zal dan linksboven in het grid worden weergegeven.

    Verwijder Panel1 en Lazarus geeft een AV en wordt afgesloten.
    Als ik echter bij Control Panel1 weghaal en daarna Panel1 verwijder dan gaat het goed.

    Hoe los je dit op, zodat je Panel1 direct kan verwijderen zonder dat Lazarus een AV geeft en niet meer werkt?

    Met een vriendelijke groet, Frans

    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.

  2. #2

  3. #3
    Ik zie nog steeds INHERITED Create(TColumnItem); staan.

    Ik heb in je andere topic hier al op gereageerd.
    Heb je die niet gelezen?

    TColumnItem is een classtype en geen instance dus volgens mij moet je iets meegeven dat als Owner kan dienen.

    (Dit op meerdere plaatsen)

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •