Neue Komponente / Width und Height ableiten

Rund um die LCL und andere Komponenten
Antworten
Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Ich bin an einer neuen Komponente schreiben, es sollte ein Steuerkreuz geben.
Dafür habe ich Button in ein Panel gelegt, so wie im Anhang.

Code: Alles auswählen

unit steuerkreuz;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Controls, Buttons, Graphics, Forms, StdCtrls, ExtCtrls;
 
type
 
  { TSteuerKreuz }
 
  TSteuerKreuz = class(TPanel)
  private
    FButtonNr: integer;
    BitBtn: array of TBitBtn;
    FHeight: integer;
    FWidth: integer;
    procedure KreuzClick(Sender: TObject);
    procedure SetButton;
    procedure SetHeight(AValue: integer);
    procedure SetWidth(AValue: integer);
  public
    property ButtonNr: integer read FButtonNr;
 
    property Width: integer read FWidth write SetWidth;
    property Height: integer read FHeight write SetHeight;
 
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
implementation
 
{ TSteuerKreuz }
 
constructor TSteuerKreuz.Create(TheOwner: TComponent);
var
  i: integer;
 
begin
  inherited Create(TheOwner);
  Caption := 'Kreuz';
  FHeight := inherited Height;
  FWidth := inherited Width;
 
  SetLength(BitBtn, 6);
 
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i] := TBitBtn.Create(Self);
    BitBtn[i].Parent := Self;
    BitBtn[i].Tag := i;
    BitBtn[i].OnClick := @KreuzClick;
  end;
  SetButton;
end;
 
destructor TSteuerKreuz.Destroy;
var
  i: integer;
begin
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Free;
  end;
  inherited Destroy;
end;
 
procedure TSteuerKreuz.KreuzClick(Sender: TObject);
begin
  FButtonNr := TButton(Sender).Tag;
  Click;
end;
 
procedure TSteuerKreuz.SetButton;
 
  procedure But(const ABitBtn: TBitBtn; ALeft, ATop: integer; ACaption: string);
  begin
    ABitBtn.Left := ALeft * Width div 3;
    ABitBtn.Top := ATop * Height div 3;
    ABitBtn.Caption := ACaption;
  end;
 
var
  i: Integer;
begin
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Height := Height div 3;
    BitBtn[i].Width := Width div 3;
  end;
 
  But(BitBtn[0], 1, 0, 'Y+');
  But(BitBtn[1], 1, 2, 'Y-');
  But(BitBtn[2], 0, 1, 'X-');
  But(BitBtn[3], 2, 1, 'X+');
  But(BitBtn[4], 0, 2, 'Z-');
  But(BitBtn[5], 2, 0, 'Z+');
end;
 
procedure TSteuerKreuz.SetHeight(AValue: integer);
var
  i: integer;
begin
  FHeight := AValue;
  inherited Height := FHeight;
 
  SetButton;
end;
 
procedure TSteuerKreuz.SetWidth(AValue: integer);
var
  i: integer;
begin
  FWidth := AValue;
  inherited Width := FWidth;
 
  SetButton;
end;
 
end.
Wen ich folgendes im Hauptprogramm mache, funktioniert es gut. Die Buttongrösse wird dem Panel angepasst.

Code: Alles auswählen

procedure TForm1.FormResize(Sender: TObject);
begin
  SteuerKreuz1.Width := ClientWidth * 2 div 3;
  SteuerKreuz1.Height := ClientHeight * 2 div 3;
end;    
Mache ich aber folgendes, dann geht es nicht.

Code: Alles auswählen

  SteuerKreuz1.Align := alClient;
Ich kann mit vorstellen, es gibt eine viel elegantere Lösung, um die Breite und Höhe anzupassen, als alle Property-Variablen abzuleiten und mit inherited wieder aufzurufen.


Wie ich es wie in einem anderen Post gelesen habe, kann ich auf die Destroy-Destructor vollkommen verzichten ?
Dateianhänge
Zwischenablage-1.png
Zwischenablage-1.png (4.08 KiB) 2854 mal betrachtet
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Benutzeravatar
theo
Beiträge: 11338
Registriert: Mo 11. Sep 2006, 19:01

Re: Neue Komponente / Width und Height ableiten

Beitrag von theo »

Musst halt auf das Event reagieren.
Sinngemäss, nicht getestet:

Code: Alles auswählen

SteuerKreuz = class(TPanel)
  private
  protected
    procedure DoOnResize; override;
  public
end;    
....
procedure SteuerKreuz.DoOnResize;
begin
  inherited DoOnResize;
   TuSonstWas;
end;    

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Danke, dies macht das Leben um einiges einfacher. :wink:

Geht dies auch eleganter ?

Code: Alles auswählen

procedure TSteuerKreuz.KreuzClick(Sender: TObject);
begin
  FButtonNr := TButton(Sender).Tag;
  Click;
end;    

Code: Alles auswählen

procedure TForm1.Panel1Click(Sender: TObject);
begin
  Caption := IntToStr(SteuerKreuz1.ButtonNr);
end;
Schön währe es, wen es so aussehen würde:

Code: Alles auswählen

procedure TForm1.Panel1Click(Sender: TObject; ButtonNr: integer);
begin
  Caption := IntToStr(ButtonNr);
end;
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Socke
Lazarusforum e. V.
Beiträge: 3188
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Neue Komponente / Width und Height ableiten

Beitrag von Socke »

Code: Alles auswählen

type
  TSteuerKreuz = class(TPanel)
  private
    procedure PanelClick(Sender: TObject; aButtonNr: PtrInt);  // einfach eine eigene Methode definieren
  // usw. [...]
  end;
 
procedure TSteuerKreuz.KreuzClick(Sender: TObject);
var
  TheButtonNr: PtrInt;
begin
  TheButtonNr := TButton(Sender).Tag;
  PanelClick(Sender, TheButtonNr);  // eigene Methode aufrufen
end;    
 
procedure TSteuerKreuz.PanelClick(Sender: TObject; aButtonNr: PtrInt);
begin
  // Sender ist jetzt ein Button
  Caption := IntToStr(aButtonNr);
end; 
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

@Socke

Irgendwas hast du durcheinander gebracht.

Code: Alles auswählen

procedure TSteuerKreuz.PanelClick(Sender: TObject; aButtonNr: PtrInt);
Diese Procedure sollte bei TForm1 sein.

Ich habe noch folgendes versucht:

Code: Alles auswählen

unit steuerkreuz;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Controls, Buttons, Graphics, Forms, StdCtrls, ExtCtrls;
 
type
 
  { TSteuerKreuz }
 
  TSteuerKreuz = class(TPanel)
  private
    FButtonNr: integer;
    BitBtn: array of TBitBtn;
    procedure KreuzClick(Sender: TObject);
  protected
    procedure DoOnResize; override;
 
  public
    OnKreuzClick: procedure(Sender: TObject; ButtonNr: integer); // Die neue Deklaration
    property ButtonNr: integer read FButtonNr;
 
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
implementation
 
{ TSteuerKreuz }
 
constructor TSteuerKreuz.Create(TheOwner: TComponent);
var
  i: integer;
begin
  inherited Create(TheOwner);
  Caption := 'Kreuz';
  SetLength(BitBtn, 6);
 
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i] := TBitBtn.Create(Self);
    BitBtn[i].Parent := Self;
    BitBtn[i].Tag := i;
    BitBtn[i].OnClick := @KreuzClick;
  end;
end;
 
destructor TSteuerKreuz.Destroy;
var
  i: integer;
begin
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Free;
  end;
  inherited Destroy;
end;
 
procedure TSteuerKreuz.KreuzClick(Sender: TObject);
begin
  FButtonNr := TButton(Sender).Tag;
  if OnKreuzClick <> nil then begin  
    OnKreuzClick(Sender, FButtonNr);
  end;
end;
 
procedure TSteuerKreuz.DoOnResize;
var
  i: integer;
 
  procedure But(const ABitBtn: TBitBtn; ALeft, ATop: integer; ACaption: string);
  begin
    ABitBtn.Left := ALeft * Width div 3;
    ABitBtn.Top := ATop * Height div 3;
    ABitBtn.Caption := ACaption;
  end;
 
begin
  inherited DoOnResize;
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Height := Height div 3;
    BitBtn[i].Width := Width div 3;
  end;
 
  But(BitBtn[0], 1, 0, 'Y+');
  But(BitBtn[1], 1, 2, 'Y-');
  But(BitBtn[2], 0, 1, 'X-');
  But(BitBtn[3], 2, 1, 'X+');
  But(BitBtn[4], 0, 2, 'Z-');
  But(BitBtn[5], 2, 0, 'Z+');
end;
 
end.
Aber bei TForm1 kann ich OnKreuzClick nichts zuordnen.
Es kommt folgender Fehler:

Code: Alles auswählen

unit1.pas(42,32) Error: Incompatible types: got "<procedure variable type of procedure(TObject,LongInt) of object;Register>" expected "TSteuerKreuz.<procedure variable type of procedure(TObject,LongInt);Register>"
Beide Proceduren haben die gleichen Parameter: procedure(TObject,LongInt)

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, steuerkreuz;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Kreuz1Click(Sender: TObject; ButtonNr: integer);
  private
    SteuerKreuz1: TSteuerKreuz;
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  SteuerKreuz1 := TSteuerKreuz.Create(Self);
  SteuerKreuz1.Parent := Self;
  SteuerKreuz1.Width := 75;
  SteuerKreuz1.Height := 75;
  SteuerKreuz1.OnKreuzClick := @Kreuz1Click; // Hier kommt der Fehler;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SteuerKreuz1.Free;
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  SteuerKreuz1.Width := ClientWidth * 2 div 3;
  SteuerKreuz1.Height := ClientHeight * 2 div 3;
end;
 
procedure TForm1.Kreuz1Click(Sender: TObject; ButtonNr: integer);
begin
  Caption := IntToStr(SteuerKreuz1.ButtonNr);
end;
 
end.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Soner
Beiträge: 803
Registriert: Do 27. Sep 2012, 00:07
OS, Lazarus, FPC: Win10Pro-64Bit, Immer letzte Lazarus Release mit SVN-Fixes
CPU-Target: x86_64-win64
Wohnort: Hamburg

Re: Neue Komponente / Width und Height ableiten

Beitrag von Soner »

Du musst es als neue Eventtyp definieren:

Code: Alles auswählen

 
type
  TKreuzClickEvent = procedure(Sender: TObject; ButtonNr: integer) of object; 
  { TSteuerKreuz }
  TSteuerKreuz = class(TPanel)
  private
    fOnKreuzClick : TKreuzClickEvent; //Hinzufügen
  public
    //Das ändern: OnKreuzClick: procedure(Sender: TObject; ButtonNr: integer); // Die neue Deklaration
    //zum : 
    property OnKreuzClick : TKreuzClickEvent read fOnKreuzClick write fOnKreuzClick; //Hinzufügen
 end;
 

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Danke, dies hat mich ein rechtes Stück weiter gebracht. Das Hauptproblem war "of object"

Ich habe den Klassenkopf jetzt so gemacht und es klappt.

Wieso gehst du über den Umweg mit TKreuzClickEvent und fOnKreuzClick ?
Hat dies einen speziellen Grund ?

Code: Alles auswählen

  TSteuerKreuz = class(TPanel)
  private
    FButtonNr: integer;
    BitBtn: array of TBitBtn;
    procedure KreuzClick(Sender: TObject);
  protected
    procedure DoOnResize; override;
 
  public
    OnKreuzClick: procedure(Sender: TObject; ButtonNr: integer) of object; // direkt deklariert
 
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;    
Ist dies der richtige Weg, OnKreuzClick auf nil zu überprüfen ?
Es kann ja sein, das im HaupForm OnKreuzClick nichts zugewiesen wird.

Code: Alles auswählen

procedure TSteuerKreuz.KreuzClick(Sender: TObject);
begin
  if OnKreuzClick <> nil then begin
    OnKreuzClick(Sender, TButton(Sender).Tag);
  end;
end;    
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Soner
Beiträge: 803
Registriert: Do 27. Sep 2012, 00:07
OS, Lazarus, FPC: Win10Pro-64Bit, Immer letzte Lazarus Release mit SVN-Fixes
CPU-Target: x86_64-win64
Wohnort: Hamburg

Re: Neue Komponente / Width und Height ableiten

Beitrag von Soner »

Mathias hat geschrieben: Wieso gehst du über den Umweg mit TKreuzClickEvent und fOnKreuzClick ?
Hat dies einen speziellen Grund ?
Wenn du nach dem setzen der Variable, noch etwas tun willst macht man das in "Setter"-Prozedur z.B. nach Sezten von Farbe die Komponente neu malen. In deinem Fall brauchst du es nicht unbedingt aber es wurde so aussehen:

Code: Alles auswählen

 
type
  TKreuzClickEvent = procedure(Sender: TObject; ButtonNr: integer) of object; 
  { TSteuerKreuz }
  TSteuerKreuz = class(TPanel)
  private
    fOnKreuzClick : TKreuzClickEvent; //Hinzufügen
    procedure SetOnKreuzClick(Value: TKreuzClickEvent); 
  public
    property OnKreuzClick : TKreuzClickEvent read fOnKreuzClick write SetOnKreuzClick; //Hinzufügen
 end;
 
//...
procedure TSteuerKreuz.SetOnKreuzClick(Value: TKreuzClickEvent);
begin
  if fOnKreuzClick=Value then exit;
  fOnKreuzClick:=Value; 
  //Hier kannst du dann irgendetwas machen das mit der Eigenschaft zu tun ist. z.B. bei FArbe/Schriftart neu malen.
end;
 

Deshalb auch TKreuzClickEvent-Typ.
Mathias hat geschrieben: Ist dies der richtige Weg, OnKreuzClick auf nil zu überprüfen ?
Es kann ja sein, das im HaupForm OnKreuzClick nichts zugewiesen wird.
Ja ist auch richtig aber es wird jetzt das verwendet:
if Assigned(OnKreuzClick) then ....

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Ich bin unterdessen so weit gekommen, das ich meine Komponente unter Package einbinden konnte.

Ich kann sie jetzt wie jede andere Komponente ins Formular ziehen, was auch sehr gut klappt.

Nun zum Problem, die neuen Eigenschaften werden im Objectinspector nicht angezeigt.
OnKreuzClick und ButtonCaption fehlen.

Code: Alles auswählen

type
  TVector3f = array[0..2] of single;
 
  { TSteuerKreuz }
 
  TButtonCaption = (abc, xyz);
  TButtonStr = array[0..5] of string;
 
  TSteuerKreuz = class(TPanel)
  private
    ButtonStr: TButtonStr;
    BitBtn: array of TBitBtn;
    FButtonCaption: TButtonCaption;
    procedure KreuzClick(Sender: TObject);
    procedure SetButtonCaption(AValue: TButtonCaption);
  protected
    procedure DoOnResize; override;
 
  public
 
    OnKreuzClick:  procedure(Sender: TObject; Vector: TVector3f) of object;
    property ButtonCaption: TButtonCaption read FButtonCaption write SetButtonCaption;
 
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Eigene', [TSteuerKreuz]);
end;     
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Benutzeravatar
theo
Beiträge: 11338
Registriert: Mo 11. Sep 2006, 19:01

Re: Neue Komponente / Width und Height ableiten

Beitrag von theo »

Gehört in die published section, public reicht nicht.
http://wiki.freepascal.org/How_To_Write ... mponent/de

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Mit puiblished geht es.
Wieso gehst du über den Umweg mit TKreuzClickEvent und fOnKreuzClick ?
Bei published muss man diesen Umweg machen, ansonsten kommt ein Kompilierfehler.

Jetzt habe ich immer noch ein keines Problem.
Wen ich im Objectinspector die Eigenschaft ButtonCaption umstelle, wird diese im Vorschau-Fomular nicht in Echtzeit umgestellt.
Komischerweise, wen ich Lazarus beende und mein Project neu lade, dann ist es umgestellt.

Wen ich es kompiliere, dann ist es auch von Anfang an richtig.

Code: Alles auswählen

unit SteuerKreuz;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Buttons;
 
type
  TVector3f = array[0..2] of single;
 
  { TSteuerKreuz }
 
  TKreuzClickEvent = procedure(Sender: TObject; Vector: TVector3f) of object;
  TButtonCaption = (abc, xyz);
  TButtonStr = array[0..5] of string;
 
  TSteuerKreuz = class(TPanel)
  private
    ButtonStr: TButtonStr;
    BitBtn: array of TBitBtn;
    FButtonCaption: TButtonCaption;
    FOnKreuzClick: TKreuzClickEvent;
    procedure KreuzClick(Sender: TObject);
    procedure SetButtonCaption(AValue: TButtonCaption);
    procedure SetOnKreuzClick(AValue: TKreuzClickEvent);
  protected
    procedure DoOnResize; override;
  published
    property ButtonCaption: TButtonCaption read FButtonCaption write SetButtonCaption;
    property OnKreuzClick: TKreuzClickEvent read FOnKreuzClick write SetOnKreuzClick;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Eigene', [TSteuerKreuz]);
end;
 
function vec3(x, y, z: single): TVector3f; inline;
begin
  Result[0] := x;
  Result[1] := y;
  Result[2] := z;
end;
 
const
  abcStr: TButtonStr = ('A-', 'A+', 'B-', 'B+', 'C-', 'C+');
  xyzStr: TButtonStr = ('X-', 'X+', 'Y-', 'Y+', 'Z-', 'Z+');
 
{ TSteuerKreuz }
 
constructor TSteuerKreuz.Create(TheOwner: TComponent);
var
  i: integer;
begin
  inherited Create(TheOwner);
  ButtonCaption := xyz;
  ButtonStr := xyzStr;
  OnKreuzClick := nil;
  Caption := 'Kreuz';
  SetLength(BitBtn, 6);
 
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i] := TBitBtn.Create(Self);
    BitBtn[i].Parent := Self;
    BitBtn[i].Tag := i;
    BitBtn[i].OnClick := @KreuzClick;
  end;
end;
 
destructor TSteuerKreuz.Destroy;
var
  i: integer;
begin
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Free;
  end;
  inherited Destroy;
end;
 
procedure TSteuerKreuz.KreuzClick(Sender: TObject);
var
  Vec: TVector3f = (0.0, 0.0, 0.0);
  Schritt: single = 1.0;
begin
  if OnKreuzClick <> nil then begin
    case TButton(Sender).Tag of
      0: begin
        Vec := vec3(-Schritt, 0.0, 0.0);
      end;
      1: begin
        Vec := vec3(Schritt, 0.0, 0.0);
      end;
      2: begin
        Vec := vec3(0.0, -Schritt, 0.0);
      end;
      3: begin
        Vec := vec3(0.0, Schritt, 0.0);
      end;
      4: begin
        Vec := vec3(0.0, 0.0, -Schritt);
      end;
      5: begin
        Vec := vec3(0.0, 0.0, Schritt);
      end;
    end;
    OnKreuzClick(Sender, Vec);
  end;
end;
 
procedure TSteuerKreuz.SetButtonCaption(AValue: TButtonCaption);
begin
  if FButtonCaption = AValue then begin
    Exit;
  end;
  FButtonCaption := AValue;
  if FButtonCaption = abc then begin
    ButtonStr := abcStr;
  end else begin
    ButtonStr := xyzStr;
  end;
end;
 
procedure TSteuerKreuz.SetOnKreuzClick(AValue: TKreuzClickEvent);
begin
  if FOnKreuzClick = AValue then begin
    Exit;
  end;
  FOnKreuzClick := AValue;
end;
 
procedure TSteuerKreuz.DoOnResize;
var
  i: integer;
 
  procedure But(const ABitBtn: TBitBtn; ALeft, ATop: integer; ACaption: string);
  begin
    ABitBtn.Left := ALeft * Width div 3;
    ABitBtn.Top := ATop * Height div 3;
    ABitBtn.Caption := ACaption;
  end;
 
begin
  inherited DoOnResize;
  for i := 0 to Length(BitBtn) - 1 do begin
    BitBtn[i].Height := Height div 3;
    BitBtn[i].Width := Width div 3;
  end;
 
  But(BitBtn[0], 0, 1, ButtonStr[0]);
  But(BitBtn[1], 2, 1, ButtonStr[1]);
  But(BitBtn[2], 1, 2, ButtonStr[2]);
  But(BitBtn[3], 1, 0, ButtonStr[3]);
  But(BitBtn[4], 0, 2, ButtonStr[4]);
  But(BitBtn[5], 2, 0, ButtonStr[5]);
end;
 
end.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

wp_xyz
Beiträge: 5443
Registriert: Fr 8. Apr 2011, 09:01

Re: Neue Komponente / Width und Height ableiten

Beitrag von wp_xyz »

Wenn ich im Objectinspector die Eigenschaft ButtonCaption umstelle, wird diese im Vorschau-Fomular nicht in Echtzeit umgestellt.
Dazu musst du am Ende von SetButtonCaption noch das Neuzeichnen veranlassen, durch Aufrufen von Invalidate.

Die Methode SetOnKreuzClick ist unnötig, weil da nur der Funktionspointer zugewiesen wird (das hatte weiter oben schon jemand geschrieben). Es geht einfacher mit:

Code: Alles auswählen

 
type
  TSteuerKreuz = class(TPanel)
  private
    FOnKreuzClick: TKreuzClickEvent;
    //...
  published
    property OnKreuzClick: TKreuzClickEvent read FOnKreuzClick write FOnKreuzClick;
  end;
 

Soner
Beiträge: 803
Registriert: Do 27. Sep 2012, 00:07
OS, Lazarus, FPC: Win10Pro-64Bit, Immer letzte Lazarus Release mit SVN-Fixes
CPU-Target: x86_64-win64
Wohnort: Hamburg

Re: Neue Komponente / Width und Height ableiten

Beitrag von Soner »

Das Problem ist, dass du in SetButtonCaption ButtonStr neuen Wert zuweist aber dieser Wert wird zu den Buttons nicht weitergeleitet. Du kannst den Fehler nachvollziehen wenn du im Designer Formgröße änderst, dann wird auch Button-Titel geändert (durch DoOnReise).
Du mußt in SetButtonCaption entweder DoOnResize aufrufen oder besser Button.Captions zuweisen (besser).

Mathias
Beiträge: 7317
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Neue Komponente / Width und Height ableiten

Beitrag von Mathias »

Ja ist auch richtig aber es wird jetzt das verwendet:
if Assigned(OnKreuzClick) then ...
Ist anscheinend nicht: http://www.delphipraxis.net/173987-unte ... igned.html
Bei mir hat es mit nil nur geklappt, weil ich es manuell zugwiesen habe.

Code: Alles auswählen

Du mußt in SetButtonCaption entweder DoOnResize aufrufen oder besser Button.Captions zuweisen (besser).
Das geht jetzt auch, bei mir kam eine Schutzverletzung, weil ich Caption vor dem Create zugewiesen habe. Ich kann ja nicht in eine Object schreiben, welches es noch nicht gibt. :oops:

Code: Alles auswählen

procedure TSteuerKreuz.SetAxis(AValue: TAxis);
begin
  if FAxis = AValue then begin
    Exit;
  end;
  FAxis := AValue;
  if x in FAxis then begin
    BitBtn[0].Visible := True;
    BitBtn[1].Visible := True;
  end else begin
    BitBtn[0].Visible := False;
    BitBtn[1].Visible := False;
  end;
  if y in FAxis then begin
    BitBtn[2].Visible := True;
    BitBtn[3].Visible := True;
  end else begin
    BitBtn[2].Visible := False;
    BitBtn[3].Visible := False;
  end;
  if z in FAxis then begin
    BitBtn[4].Visible := True;
    BitBtn[5].Visible := True;
  end else begin
    BitBtn[4].Visible := False;
    BitBtn[5].Visible := False;
  end;
end;   
Die Button, werden im Designer nicht auf Visible gesetzt, aber ich vermute, dies ist normal.
Bei den Standard-Komponenten geht dies auch nicht.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Antworten