paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 01:57:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

MG: fixed client rectangles, TRadioGroup, RecreateWnd

Browse Source 
git-svn-id: trunk@1676 -
This commit is contained in:
lazarus 2002-05-13 14:47:01 +00:00
parent 55c755f6f0
commit c01f402583
8 changed files with 153 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -1657,6 +1657,8 @@ endif
tools: lcl components tools_all
all: lcl components ide
cleanide:
$(DEL) $(wildcard *$(OEXT))
$(DEL) $(wildcard *$(PPUEXT))
$(DEL) $(wildcard ./designer/*$(OEXT))
$(DEL) $(wildcard ./designer/*$(PPUEXT))
$(DEL) $(wildcard ./debugger/*$(OEXT))

2
Makefile.fpc
View File

@ -60,6 +60,8 @@ tools: lcl components tools_all
all: lcl components ide
cleanide:
$(DEL) $(wildcard *$(OEXT))
$(DEL) $(wildcard *$(PPUEXT))
$(DEL) $(wildcard ./designer/*$(OEXT))
$(DEL) $(wildcard ./designer/*$(PPUEXT))
$(DEL) $(wildcard ./debugger/*$(OEXT))

3
ide/environmentopts.pp
View File

@ -34,6 +34,9 @@ unit EnvironmentOpts;
interface
uses
{$IFDEF IDE_MEM_CHECK}
MemCheck,
{$ENDIF}
Classes, SysUtils, Forms, Controls, Buttons, XMLCfg, ObjectInspector,
ExtCtrls, StdCtrls, EditorOptions, LResources, LazConf, Dialogs,
ExtToolDialog, IDEProcs, IDEOptionDefs;

15
lcl/extctrls.pp
View File

@ -296,11 +296,6 @@ type
(currently) maintained by Stefan Hille (stoppok@osibisa.ms.sub.org)
}
TCustomRadioGroup = class(TCustomGroupBox)
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
function CanModify : boolean; virtual;
procedure CreateWnd; override;
private
FButtonList : TList; // list of TRadioButton
FCreatingWnd: boolean;
@ -311,12 +306,19 @@ type
FOnClick : TNotifyEvent;
procedure ItemsChanged (Sender : TObject);
procedure Clicked(Sender : TObject); virtual;
procedure DoPositionButtons;
public
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
function CanModify : boolean; virtual;
procedure CreateWnd; override;
protected
procedure ReadState(Reader: TReader); override;
procedure SetItem (value : TStrings);
procedure SetColumns (value : integer);
procedure SetItemIndex (value : integer);
function GetItemIndex : integer;
procedure WMSize(var Message: TLMSize); message LM_SIZE;
property ItemIndex : integer read GetItemIndex write SetItemIndex default -1;
property Items : TStrings read FItems write SetItem;
property Columns : integer read FColumns write SetColumns default 1;
@ -441,6 +443,9 @@ end.
{
$Log$
Revision 1.24 2002/05/13 14:47:00 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd
Revision 1.23 2002/05/10 06:05:50 lazarus
MG: changed license to LGPL

115
lcl/include/customradiogroup.inc
View File

@ -97,62 +97,40 @@ procedure TCustomRadioGroup.CreateWnd;
var
i : integer;
temp : TRadioButton;
nextTop : integer;
nextLeft: integer;
vertDist: integer;
horzDist: integer;
rbWidth : integer;
begin
if FCreatingWnd then exit;
FCreatingWnd := true;
//writeln('[TCustomRadioGroup.CreateWnd] A ',FItems.Count);
//writeln('[TCustomRadioGroup.CreateWnd] A ',Name,':',ClassName,' ',FItems.Count);
// destroy radiobuttons, if there are too many
while FButtonList.Count>FItems.Count do begin
TRadioButton(FButtonList[FButtonList.Count-1]).Free;
FButtonList.Delete(FButtonList.Count-1);
end;
if FItems.Count>0 then begin
if (FItemIndex>=FItems.Count) or (FItemIndex<0) then FItemIndex:=0;
vertDist := (Height - 20) DIV (((FItems.Count-1) DIV FColumns)+1);
horzDist := (Width - 20) DIV FColumns;
nextTop := 0;
nextLeft := 10;
rbWidth := horzDist;
// destroy if there are too many
for i:=0 to FButtonList.Count-1 do
TRadioButton(FButtonList[i]).Free;
FButtonList.Clear;
{while (FButtonList.Count>FItems.Count) do begin
Temp:=TRadioButton(FButtonList[FButtonList.Count-1]);
Temp.Free;
FButtonList.Delete(FButtonList.Count-1);
end;}
// create as many TRadioButton as needed
while (FButtonList.Count<FItems.Count) do begin
Temp := TRadioButton.Create (self);
Temp.Parent := self;
Temp.Parent := Self;
Temp.OnClick := @Clicked;
FButtonList.Add(Temp);
end;
// position in rows and columns
if (FItemIndex>=FItems.Count) or (FItemIndex<0) then FItemIndex:=0;
DoPositionButtons;
i := 0;
while i < FItems.Count do begin
Temp := TRadioButton(FButtonList[i]);
Temp.Top := nextTop;
Temp.Left := nextLeft;
Temp.Width := rbWidth;
Temp.Height := vertDist;
Temp.Caption := FItems.Strings[i];
Temp.Checked := (i = FItemIndex);
inc (i);
if (i MOD FColumns) = 0 then begin
inc(nextTop, vertDist);
nextLeft := 10;
end else begin
inc(nextLeft, horzDist);
end;
Temp.Visible:=true;
inc(i);
end;
end;
//writeln('[TCustomRadioGroup.CreateWnd] B ',FItems.Count);
//writeln('[TCustomRadioGroup.CreateWnd] B ',Name,':',ClassName,' ',FItems.Count);
inherited CreateWnd;
//writeln('[TCustomRadioGroup.CreateWnd] C ',FItems.Count);
//writeln('[TCustomRadioGroup.CreateWnd] C ',Name,':',ClassName,' ',FItems.Count);
FCreatingWnd := false;
end;
@ -199,7 +177,7 @@ end;
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.SetItem (value : TStrings);
begin
if Value <> FItems then
if (Value <> FItems) then
begin
FItems.Assign(Value);
if HandleAllocated then RecreateWnd;
@ -253,9 +231,9 @@ begin
// when a button is pressed
while (i < FButtonList.Count) and (Result = -1) do
begin // find the actice button
if TRadioButton (FButtonList [i]).Checked
then result := i;
inc (i);
if TRadioButton (FButtonList [i]).Checked
then result := i;
inc (i);
end;
FItemIndex := Result;
end
@ -263,6 +241,19 @@ begin
Result := FItemIndex;
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.WMSize
Params: Message: TLMSize
Returns: none
Reposition buttons on resize
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.WMSize(var Message: TLMSize);
begin
if HandleAllocated then DoPositionButtons;
inherited;
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.CanModify
Params: none
@ -303,8 +294,50 @@ Begin
if Assigned (FOnClick) then FOnClick(Self);
end;
{------------------------------------------------------------------------------
Method: TCustomRadioGroup.DoPositionButtons
Params: none
Set bounds of radio buttons
------------------------------------------------------------------------------}
procedure TCustomRadioGroup.DoPositionButtons;
var
i : integer;
temp : TRadioButton;
nextTop : integer;
nextLeft: integer;
vertDist: integer;
horzDist: integer;
rbWidth : integer;
begin
if FItems.Count>0 then begin
// position in rows and columns
vertDist := (Height - 20) DIV (((FItems.Count-1) DIV FColumns)+1);
horzDist := (Width - 20) DIV FColumns;
nextTop := 0;
nextLeft := 10;
rbWidth := horzDist;
i := 0;
while i < FItems.Count do begin
Temp := TRadioButton(FButtonList[i]);
Temp.SetBounds(nextLeft,nextTop,rbWidth,vertDist);
inc (i);
if (i MOD FColumns) = 0 then begin
inc(nextTop, vertDist);
nextLeft := 10;
end else begin
inc(nextLeft, horzDist);
end;
end;
end;
end;
{
$Log$
Revision 1.11 2002/05/13 14:47:00 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd
Revision 1.10 2002/05/13 06:12:57 lazarus
MG: fixed saving unitlinks after changing fpc soure path

79
lcl/include/radiobutton.inc
View File

@ -48,15 +48,12 @@
------------------------------------------------------------------------------}
constructor TRadioButton.Create(AOwner : TComponent);
begin
if assigned(AOwner) then
begin
inherited Create(AOwner);
fCompStyle := csRadioButton;
Visible := False;
Hint := 'Radiobutton';
ShowHint := True;
fGroup := 0;
end;
inherited Create(AOwner);
fCompStyle := csRadioButton;
Visible := False;
Hint := 'Radiobutton';
ShowHint := True;
fGroup := 0;
end;
{------------------------------------------------------------------------------
@ -73,23 +70,54 @@ end;
property will be 0.
In the interface we can then use the group property to decide if
a new group has to be created or which radiobutton is the
predecessor.
predecessor. The first radiobutton, which handle is created, will get as Group
the group handle.
This behaviour is especially neccessary for the GTK bindings.
------------------------------------------------------------------------------}
procedure TRadioButton.CreateWnd;
var
i : integer;
temp : TComponent;
i : integer;
temp : TComponent;
begin
i := Owner.ComponentCount-1;
while (i >= 0) and (fGroup = 0) do
begin // search for radiobutton which is predecessor
Temp := Owner.Components [i];
if (Temp is TRadioButton) and (TRadioButton (temp).fGroup <> 0)
then fGroup := THandle (TRadioButton(Temp).Handle); // set group to our predecessor
dec (i);
end;
inherited CreateWnd;
fGroup:=0;
i := Owner.ComponentCount-1;
while (i >= 0) and (fGroup = 0) do
begin // search for radiobutton which is predecessor
Temp := Owner.Components [i];
if (Temp is TRadioButton) and (TRadioButton (temp).fGroup <> 0) then
fGroup := THandle (TRadioButton(Temp).Handle); // set group to our predecessor
dec (i);
end;
inherited CreateWnd;
end;
{------------------------------------------------------------------------------
Method: TRadioButton.DestroyWnd
Params: none
Returns: Nothing
The handle is destroyed, and therefore the radiobutton does not belong any
longer to a group. The Group property is the handle of the predecessor
TRadioButton.
-> Bind the successor TRadioButton to our predecessor
------------------------------------------------------------------------------}
procedure TRadioButton.DestroyWnd;
var
i: integer;
ARadioButton: TRadioButton;
begin
if fGroup<>0 then begin
if HandleAllocated then begin
for i:=0 to Owner.ComponentCount-1 do
if (Owner.Components[i] is TRadioButton) then begin
ARadioButton:=TRadioButton(Owner.Components[i]);
if ARadioButton.fGroup=Handle then
ARadioButton.fGroup:=fGroup;
end;
end;
fGroup:=0;
end;
inherited DestroyWnd;
end;
{------------------------------------------------------------------------------
@ -101,8 +129,8 @@ end;
------------------------------------------------------------------------------}
procedure TRadioButton.SetGroup(Value : THandle);
begin
Assert(False, 'Trace:IN SETGROUP. Caption = '+ Self.Caption);
FGroup := Value;
Assert(False, 'Trace:IN SETGROUP. Caption = '+ Self.Caption);
FGroup := Value;
//SH? ReCreate;
end;
@ -115,7 +143,7 @@ end;
------------------------------------------------------------------------------}
function TRadioButton.GetGroup : THandle;
begin
GetGroup := FGroup;
GetGroup := FGroup;
end;
// included by stdctrls.pp
@ -153,6 +181,9 @@ end;
{
$Log$
Revision 1.5 2002/05/13 14:47:00 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd
Revision 1.4 2002/05/13 06:12:57 lazarus
MG: fixed saving unitlinks after changing fpc soure path

46
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -834,43 +834,6 @@ end;
function gtksize_allocateCB(widget: PGtkWidget; size :pGtkAllocation;
data: gPointer) : GBoolean; cdecl;
{$IFDEF ClientRectBugFix}
procedure UpdateParentSizes(AParent: TWinControl);
var
OldLeft, OldTop, OldWidth, OldHeight: integer;
NewLeft, NewTop, NewWidth, NewHeight: integer;
ParentWidget: PGtkWidget;
begin
if AParent=nil then exit;
AParent.InvalidateClientRectCache;
UpdateParentSizes(AParent.Parent);
if (not AParent.HandleAllocated) then exit;
// update size
OldLeft:=AParent.Left;
OldTop:=AParent.Top;
OldWidth:=AParent.Width;
OldHeight:=AParent.Height;
ParentWidget:=PGtkWidget(AParent.Handle);
NewLeft:=ParentWidget^.Allocation.x;
NewTop:=ParentWidget^.Allocation.y;
NewWidth:=ParentWidget^.Allocation.Width;
NewHeight:=ParentWidget^.Allocation.Height;
{$IFDEF VerboseSizeMsg}
writeln(' UpdateParentSizes ',AParent.Name,':',AParent.ClassName,
' LCL=',OldLeft,',',OldTop,',',OldWidth,',',OldHeight,
' GTK=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight
);
{$ENDIF}
// update client rectangle
if AParent is TWinControl then
TWinControl(AParent).DoAdjustClientRectChange;
end;
{$ENDIF}
var
PosMsg : TLMWindowPosChanged;
SizeMsg: TLMSize;
@ -914,8 +877,6 @@ begin
SaveSizeNotification(Widget);
Result:=true;
exit;
UpdateParentSizes(TControl(Data).Parent);
{$ENDIF}
OldLeft:=TControl(Data).Left;
@ -1027,13 +988,9 @@ end;}
end;
end;
{$IFDEF ClientRectBugFix}
{$ELSE}
if not (TopLeftChanged or WidthHeightChanged)
and (TObject(Data) is TWinControl) then
TWinControl(Data).DoAdjustClientRectChange;
{$ENDIF}
end;
{$IFDEF ClientRectBugFix}
@ -1757,6 +1714,9 @@ end;
{ =============================================================================
$Log$
Revision 1.74 2002/05/13 14:47:01 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd
Revision 1.73 2002/05/10 06:05:56 lazarus
MG: changed license to LGPL

6
lcl/stdctrls.pp
View File

@ -483,8 +483,6 @@ type
{TRadioButton}
TRadioButton = Class; //Forward Declaration
TRadioButton = class(TCustomCheckBox)
private
fGroup : THandle; // handle to the previous button in the group this button belongs to
@ -492,6 +490,7 @@ type
function GetGroup : THandle;
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
public
constructor Create (AOwner: TComponent); override;
property group : THandle read GetGroup write SetGroup;
@ -594,6 +593,9 @@ end.
{ =============================================================================
$Log$
Revision 1.29 2002/05/13 14:47:00 lazarus
MG: fixed client rectangles, TRadioGroup, RecreateWnd
Revision 1.28 2002/05/10 06:05:50 lazarus
MG: changed license to LGPL