Hi Lazarus list,
I am making public a private message between myself and Ido, re some
changes to ButtonList.pas.
Please find attached buttonlist.pas and testunit1.pas which contains the
relevant code.
> testunit1.pas(65,9) Error: identifier idents no member
> "SetSpecificCaption"
> testunit1.pas(66,20) Error: Incompatible types: got "untyped" expected
> "<procedure variable type of procedure(TObject) of object;Register>"
> testunit1.pas(75) Fatal: There were 2 errors compiling module,
> stopping
>
> lines 65 & 66 follow:
> sg1.SetSpecificCaption( b, X_str + inttostr(b) );
> sg1.OnClick := Button1Click(self);
>
>From buttonlist.pas
> procedure TCustomButtonList.SetSpecificCaption(num : integer; Str :
> String);
> begin
> if (num > High(FButtons)) or (num < Low(FButtons)) then
> raise Exception.Create('Set Caption Out of range');
>
> FButtons[num].Caption := Str;
> end;
>
I would appreciate your help debugging these errors. :-)))
Best Regards,
PEW (Peter)
Hobart, Tasmania, Australia
>
> On Mon, 2010-08-30 at 22:45 +0300, ik wrote:
> > Hi Peter,
> >
> > Your requests are not supported by the component, but it can be
> > rewritten like so:
> >
> > TAdvancedCustomButtonList = class(TCustomButtonList)
> >
> > Note that you have access to FButtons (it's the actual array of the
> > buttons).
> >
> > so a procedure like so can be written:
> >
> > procedure TAdvancedCustomButtonList.SetSpecificCaption(num :
> integer;
> > Caption : String);
> > begin
> > if num > High(FButtons) or num < Low(FButtons) then
> > raise Exception.Create('Out of range');
> >
> > FButtons[num].Caption := Caption;
> > end;
> >
> > and also:
> >
> > procedure TAdvancedCustomButtonList.SetFont(num : integer; Font :
> > TFont);
> > begin
> > if num >Hi Lazarus list,
I am making public a private message between myself and Ido, re some
changes to ButtonList.pas.
Please find attached buttonlist.pas and testunit1.pas which contains the
relevant code.
> testunit1.pas(65,9) Error: identifier idents no member
> "SetSpecificCaption"
> testunit1.pas(66,20) Error: Incompatible types: got "untyped" expected
> "<procedure variable type of procedure(TObject) of object;Register>"
> testunit1.pas(75) Fatal: There were 2 errors compiling module,
> stopping
>
> lines 65 & 66 follow:
> sg1.SetSpecificCaption( b, X_str + inttostr(b) );
> sg1.OnClick := Button1Click(self);
>
>From buttonlist.pas
> procedure TCustomButtonList.SetSpecificCaption(num : integer; Str :
> String);
> begin
> if (num > High(FButtons)) or (num < Low(FButtons)) then
> raise Exception.Create('Set Caption Out of range');
>
> FButtons[num].Caption := Str;
> end;
>
I would appreciate your help debugging these errors. :-)))
Best Regards,
PEW (Peter)
Hobart, Tasmania, Australia
>
> On Mon, 2010-08-30 at 22:45 +0300, ik wrote:
> > Hi Peter,
> >
> > Your requests are not supported by the component, but it can be
> > rewritten like so:
> >
> > TAdvancedCustomButtonList = class(TCustomButtonList)
> >
> > Note that you have access to FButtons (it's the actual array of the
> > buttons).
> >
> > so a procedure like so can be written:
> >
> > procedure TAdvancedCustomButtonList.SetSpecificCaption(num :
> integer;
> > Caption : String);
> > begin
> > if num > High(FButtons) or num < Low(FButtons) then
> > raise Exception.Create('Out of range');
> >
> > FButtons[num].Caption := Caption;
> > end;
> >
> > and also:
> >
> > procedure TAdvancedCustomButtonList.SetFont(num : integer; Font :
> > TFont);
> > begin
> > if num > High(FButtons) or num < Low(FButtons) then
> > raise Exception.Create('Out of range');
> >
> > FButtons[num].Font.Assign(Font);
> > end;
> >
> > Please note that I have not tried it myself, but that's the idea of
> > how to do it.
> >
> > I hope that helps, and feel free to ask more questions, or to be
> > pointed for additional information.
> >
> > Ido
> >
> > http://ik.homelinux.org/
> >
> >
> > On Mon, Aug 30, 2010 at 22:06, Peter E Williams
> > <[email protected]> wrote:
> > Hi Ido,
> >
> > I am using your component, ButtonList, and creating it at
> > runtime. I am
> > having some problems doing the following:
> >
> > Assigning a caption to the x'th button:
> >
> > what I want to do is this...
> >
> > var
> > BtnList : TButtonList;
> >
> > begin
> > BtnList := TButtonList.Create(self);
> > BtnList.parent := self;
> > BtnList.visible := true;
> > BtnList.count := 8;
> >
> > // this next line is the problem
> >
> > BtnList.caption[x] := 'hello';
> >
> > but I see that you have a procedure 'Captions' which accepts
> a
> > TStringList as it's parameter. I don't have a TStringList,
> and
> > I don't
> > want to reset every caption, only the x'th one.
> >
> > Likewise, I want to set the font color for the x'th button,
> > like:
> >
> > BtnList.font[x].color := clBlue;
> >
> > Can I do this or something similar???
> >
> > Best Regards,
> > PEW
> > Hobart, Tasmania, Australia
> >
> > --
> > Proudly developing Quality Cross Platform Open Source Games
> > Since 1970 with a Commodore PET 4016 with 16 KRAM
> > http://pews-freeware-games.org (<--- brand new)
> > High(FButtons) or num < Low(FButtons) then
> > raise Exception.Create('Out of range');
> >
> > FButtons[num].Font.Assign(Font);
> > end;
> >
> > Please note that I have not tried it myself, but that's the idea of
> > how to do it.
> >
> > I hope that helps, and feel free to ask more questions, or to be
> > pointed for additional information.
> >
> > Ido
> >
> > http://ik.homelinux.org/
> >
> >
> > On Mon, Aug 30, 2010 at 22:06, Peter E Williams
> > <[email protected]> wrote:
> > Hi Ido,
> >
> > I am using your component, ButtonList, and creating it at
> > runtime. I am
> > having some problems doing the following:
> >
> > Assigning a caption to the x'th button:
> >
> > what I want to do is this...
> >
> > var
> > BtnList : TButtonList;
> >
> > begin
> > BtnList := TButtonList.Create(self);
> > BtnList.parent := self;
> > BtnList.visible := true;
> > BtnList.count := 8;
> >
> > // this next line is the problem
> >
> > BtnList.caption[x] := 'hello';
> >
> > but I see that you have a procedure 'Captions' which accepts
> a
> > TStringList as it's parameter. I don't have a TStringList,
> and
> > I don't
> > want to reset every caption, only the x'th one.
> >
> > Likewise, I want to set the font color for the x'th button,
> > like:
> >
> > BtnList.font[x].color := clBlue;
> >
> > Can I do this or something similar???
> >
> > Best Regards,
> > PEW
> > Hobart, Tasmania, Australia
> >
> > --
> > Proudly developing Quality Cross Platform Open Source Games
> > Since 1970 with a Commodore PET 4016 with 16 KRAM
> > http://pews-freeware-games.org (<--- brand new)
> >
--
Proudly developing Quality Cross Platform Open Source Games
Since 1970 with a Commodore PET 4016 with 16 KRAM
http://pews-freeware-games.org (<--- brand new)
{ A Lazarus component for button list
Copyright (C) 2010 Ido Kanner [email protected]
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit buttonlist;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Buttons, Controls, Forms, LMessages, Graphics;
type
TLayoutDirection = (ldHorizontal, ldVertical);
Const
DEFAULT_BREAK_ON = 5;
DEFAULT_BUTTON_COUNT = 10;
DEFAULT_LAYOUT_DIRECTION = ldVertical;
DEFAULT_SHOW_BUTTON_HINTS = true;
type
EButtonCount = class(Exception);
TButtonClick = procedure (Index : Word) of object;
{ TCustomButtonList }
TCustomButtonList = class(TScrollingWinControl)
private
procedure SetBreakOn ( const AValue : Word ) ;
procedure SetButtonCount ( const AValue : Word ) ;
procedure SetLayoutDirection ( const AValue : TLayoutDirection ) ;
procedure SetCaptions ( const AValue : TStringList ) ;
procedure SetHints ( const AValue : TStringList ) ;
procedure SetButtonHints ( const AValue : Boolean ) ;
procedure SetSpecificCaption(num : integer; Str : String); virtual;
procedure SetFont(num : integer; AFont : TFont); virtual;
function GetSpecificCaption(num : integer ): String; virtual;
function GetFont(num : integer) : TFont; virtual;
procedure SetFontColor(num : integer; AColor : TColor); virtual;
function GetFontColor(num : integer) : TColor; virtual;
protected
FBreakOn : Word;
FButtons : array of TBitBtn;
FButtonCount : Word;
FCaptions : TStringList;
FHints : TStringList;
FLayoutDirection : TLayoutDirection;
FShowButtonHints : Boolean;
FButtonClick : TButtonClick;
procedure CreateButtons(const aFrom, aTo : Word); virtual;
procedure CreateButtons; virtual;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
function CalcHeight : Integer; virtual;
function LayoutDirectionToChildLayout(const aDirection : TLayoutDirection) : TControlChildrenLayout; virtual;
procedure UpdateCaptions; virtual;
procedure UpdateHints; virtual;
procedure CaptionChanged(Sender : TObject); virtual;
procedure HintChanged(Sender : TObject); virtual;
procedure ButtonClicked(Sender : TObject); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BreakOn : Word read FBreakOn write SetBreakOn
default DEFAULT_BREAK_ON;
property Captions : TStringList read FCaptions write SetCaptions;
property Count : Word read FButtonCount write SetButtonCount
default DEFAULT_BUTTON_COUNT;
property Hints : TStringList read FHints write SetHints;
property LayoutDirection : TLayoutDirection read FLayoutDirection
write SetLayoutDirection
default DEFAULT_LAYOUT_DIRECTION;
property ShowHints : Boolean read FShowButtonHints write SetButtonHints
default DEFAULT_SHOW_BUTTON_HINTS;
property OnButtonClick : TButtonClick read FButtonClick write FButtonClick;
end;
TButtonList = class(TCustomButtonList)
published
property Align;
property Anchors;
property AutoScroll default True;
property AutoSize;
property BorderSpacing;
property BiDiMode;
property BorderStyle default bsSingle;
property BreakOn;
property Captions;
property ChildSizing;
property ClientHeight;
property ClientWidth;
property Constraints;
property Count;
property Color nodefault;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property LayoutDirection;
property ParentBiDiMode;
property ParentColor;
property Parlines 65 & 66 follow:
sg1.SetSpecificCaption( b, X_str + inttostr(b) );
sg1.OnClick := Button1Click(self);
entFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property ShowHints;
property TabOrder;
property TabStop;
property Visible;
property OnButtonClick;
property OnClick;
property OnConstrainedResize;
property OnDblClick;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
property OnPaint;
end;
//procedure Register;
resourcestring
errCreationIndexOutOfRange = 'Creation index out of range';
errToIsBiggerThenFrom = 'To is bigger then from';
errCannotCreateEmptyButtonList = 'Cannot create empty button list';
implementation
{ TCustomButtonList }
constructor TCustomButtonList.Create ( AOwner : TComponent ) ;
begin
inherited Create ( AOwner ) ;
ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption]
+ [csOpaque];
SetInitialBounds(
0, 0,
GetControlClassDefaultSize.X,
GetControlClassDefaultSize.Y
);
FBreakOn := DEFAULT_BREAK_ON;
FButtonCount := DEFAULT_BUTTON_COUNT;
FLayoutDirection := DEFAULT_LAYOUT_DIRECTION;
// Setting control layout
ChildSizing.Layout := LayoutDirectionToChildLayout(FLayoutDirection);
ChildSizing.ControlsPerLine := FBreakOn;
ChildSizing.EnlargeHorizontal := crsScaleChilds;
AutoScroll := True;
AutoSize := False;
FCaptions := TStringList.Create;
FCaptions.OnChange := @CaptionChanged;
FHints := TStringList.Create;
FHints.OnChange := @HintChanged;
FShowButtonHints := DEFAULT_SHOW_BUTTON_HINTS;
SetLength(FButtons, FButtonCount);
CreateButtons;
end;
destructor TCustomButtonList.Destroy;
var
i : word;
begin
FreeAndNil(FCaptions);
FreeAndNil(FHints);
for i := Low(FButtons) to High(FButtons) do
begin
if Assigned(FButtons[i]) then
FreeAndNil(FButtons[i]);
end;
inherited Destroy;
end;
procedure TCustomButtonList.CreateButtons ( const aFrom, aTo : Word ) ;
var
i : integer;
BtnHeight : integer;
begin
if aFrom > High(FButtons) then
raise EButtonCount.Create(errCreationIndexOutOfRange);
if aTo = 0 then raise EButtonCount.Create(errCreationIndexOutOfRange);
if aFrom > aTo then raise EButtonCount.Create(errToIsBiggerThenFrom);
BtnHeight := CalcHeight;
for i := aFrom to aTo do
begin
if not Assigned(FButtons[i]) then
FButtons[i] := TBitBtn.Create(self);
FButtons[i].AutoSize := true;
FButtons[i].Parent := Self;
FButtons[i].ShowHint := FShowButtonHints;
FButtons[i].Constraints.MinHeight := BtnHeight;
FButtons[i].Tag := i;
FButtons[i].OnClick := @ButtonClicked;
end;
end;
procedure TCustomButtonList.CreateButtons;
begin
CreateButtons(Low(FButtons), High(FButtons));
end;
procedure TCustomButtonList.WMSize ( var Message : TLMSize ) ;
var
i : integer;
BtnHeight : integer;
begin
Message.Result := 1;
// Recalculate the height of the buttons
// depands on the new height
BtnHeight := CalcHeight;
for i := Low(FButtons) to High(FButtons) do
begin
FButtons[i].Constraints.MinHeight := BtnHeight;
end;
if Assigned(OnResize) then
OnResize(Self);
end;
function TCustomButtonList.CalcHeight : Integer;
begin
Result := (Self.ClientHeight div FBreakOn);
// We can not go bellow 26 pixels on hight
if Result < 30 then
Result := 30;
end;
function TCustomButtonList.LayoutDirectionToChildLayout (
const aDirection : TLayoutDirection ) : TControlChildrenLayout;
const
Layout : array[TLayoutDirection] of TControlChildrenLayout =
(cclLeftToRightThenTopToBottom, cclTopToBottomThenLeftToRight);
begin
Result := Layout[aDirection];
end;
procedure TCustomButtonList.SetBreakOn ( const AValue : Word ) ;
begin
if AValue <> FBreakOn then
begin
FBreakOn := AValue;
ChildSizing.ControlsPerLine := FBreakOn;
end;
end;
procedure TCustomButtonList.SetButtonCount ( const AValue : Word ) ;
var
i : integer;
begin
if AValue = 0 then
raise EButtonCount.Create(errCannotCreateEmptyButtonList);
if AValue <> FButtonCount then
begin
if FButtonCount > AValue then
begin
for i := AValue to FButtonCount -1 do
FreeAndNil(FButtons[i]);
SetLength(FButtons, AValue); // shrink array
end
else begin
SetLength(FButtons, AValue); // resize array
CreateButtons(FButtonCount, AValue-1);
end;
FButtonCount := AValue;
end;
end;
procedure TCustomButtonList.SetLayoutDirection (
const AValue : TLayoutDirection ) ;
begin
if AValue <> FLayoutDirection then
begin lines 65 & 66 follow:
sg1.SetSpecificCaption( b, X_str + inttostr(b) );
sg1.OnClick := Button1Click(self);
FLayoutDirection := AValue;
ChildSizing.Layout := LayoutDirectionToChildLayout(FLayoutDirection);
end;
end;
procedure TCustomButtonList.CaptionChanged ( Sender : TObject ) ;
begin
UpdateCaptions;
end;
procedure TCustomButtonList.HintChanged ( Sender : TObject ) ;
begin
UpdateHints;
end;
procedure TCustomButtonList.UpdateCaptions;
var
i : word;
max_captions : word;
begin
if FCaptions.Count <= 0 then exit;
if FCaptions.Count > Length(FButtons) then
max_captions := Length(FButtons)
else
max_captions := FCaptions.Count;
for i := 0 to max_captions -1 do
begin
FButtons[i].Caption := FCaptions.Strings[i];
end;
end;
procedure TCustomButtonList.UpdateHints;
var
i : word;
max_hints : word;
begin
if FHints.Count <= 0 then exit;
if FHints.Count > Length(FButtons) then
max_hints := Length(FButtons)
else
max_hints := FHints.Count;
for i := 0 to max_hints -1 do
begin
FButtons[i].Hint := FHints.Strings[i];
end;
end;
procedure TCustomButtonList.SetCaptions ( const AValue : TStringList ) ;
begin
if AValue.Equals(FCaptions) then exit;
FCaptions.Clear;
FCaptions.Assign(AValue);
UpdateCaptions;
end;
procedure TCustomButtonList.SetHints ( const AValue : TStringList ) ;
begin
if AValue.Equals(FHints) then exit;
FHints.Clear;
FHints.Assign(AValue);
UpdateHints;
end;
procedure TCustomButtonList.SetButtonHints ( const AValue : Boolean ) ;
var
i : word;
begin
if FShowButtonHints = AValue then exit;
FShowButtonHints := AValue;
for i := Low(FButtons) to High(FButtons) do
begin
FButtons[i].ShowHint := FShowButtonHints;
end;
end;
procedure TCustomButtonList.ButtonClicked ( Sender : TObject ) ;
begin
if Assigned(FButtonClick) then
FButtonClick(TBitBtn(Sender).Tag);
end;
procedure TCustomButtonList.SetSpecificCaption(num : integer; Str : String);
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Set Caption Out of range');
FButtons[num].Caption := Str;
end;
procedure TCustomButtonList.SetFont(num : integer; AFont : TFont);
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Set Font Out of range');
FButtons[num].Font.Assign(AFont);
end;
function TCustomButtonList.GetSpecificCaption(num : integer ): String;
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Get Caption Out of range');
result := FButtons[num].Caption;
end;
function TCustomButtonList.GetFont(num : integer) : TFont;
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Get Font Out of range');
result := FButtons[num].Font;
end;
procedure TCustomButtonList.SetFontColor(num : integer; AColor : TColor);
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Set Font Out of range');
FButtons[num].Font.Color := AColor;
end;
function TCustomButtonList.GetFontColor(num : integer) : TColor;
begin
if (num > High(FButtons)) or (num < Low(FButtons)) then
raise Exception.Create('Set Font Out of range');
result := FButtons[num].Font.Color;
end;
{
procedure Register;
begin
RegisterComponents('LINESIP Buttons', [TButtonList]);
end;
}
end.
unit testunit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ButtonList;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
Showmessage( 'You clicked me.' );
end;
procedure TForm1.FormCreate(Sender: TObject);
var
b, x1, y1: integer;
var sg1: TButtonList;
const
max_level = 8;
max_byte = 255;
demo = false;
X_str = 'X';
O_str = 'O';
empty_cell = '';
begin
sg1 := TButtonList.Create(self);
sg1.Count := max_level;
{
for j := 0 to sg1.Count do
begin
sg1[ j ].MouseMove := ButtonBoard_MouseMove;
sg1[ j ].MouseDown := ButtonBoard_MouseDown;
end;
}
sg1.parent := self;
sg1.visible := True;
for b := 1 to max_level do
begin
sg1.SetSpecificCaption( b, X_str + inttostr(b) );
sg1.OnClick := Button1Click(self);
end;
end;
initialization
{$I testunit1.lrs}
end.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
