paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 03:23:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed taborder=0, implemented TabOrder Editor

Browse Source 
git-svn-id: trunk@2570 -
This commit is contained in:
mattias 2002-08-17 23:41:29 +00:00
parent 6de14d6998
commit ecef43463f
5 changed files with 334 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -112,6 +112,9 @@ designer/objinspstrconsts.pas svneol=native#text/pascal
designer/propedits.pp svneol=native#text/pascal
designer/scalecompsdlg.pp svneol=native#text/pascal
designer/sizecompsdlg.pp svneol=native#text/pascal
designer/taborderdlg.lfm svneol=native#text/plain
designer/taborderdlg.lrs svneol=native#text/pascal
designer/taborderdlg.pas svneol=native#text/pascal
docs/Packages.txt svneol=native#text/plain
examples/bitbtnform.pp svneol=native#text/pascal
examples/bitbutton.pp svneol=native#text/pascal

94
designer/taborderdlg.lfm Normal file
View File

@ -0,0 +1,94 @@
object TabOrderDialog: TTabOrderDialog
CAPTION = 'TabOrderDialog'
CLIENTHEIGHT = 387
CLIENTWIDTH = 310
ONCLOSE = TabOrderDialogCLOSE
ONCREATE = TabOrderDialogCREATE
HORZSCROLLBAR.PAGE = 311
VERTSCROLLBAR.PAGE = 388
LEFT = 381
HEIGHT = 387
TOP = 167
WIDTH = 310
object UpSpeedbutton: TSPEEDBUTTON
ANCHORS = [aktop, akright]
NUMGLYPHS = 0
ONCLICK = UpSpeedbuttonCLICK
SHOWHINT = True
PARENTSHOWHINT = False
LEFT = 265
HEIGHT = 25
HINT = 'Move Up'
TOP = 119
WIDTH = 25
end
object DownSpeedbutton: TSPEEDBUTTON
ANCHORS = [aktop, akright]
NUMGLYPHS = 0
ONCLICK = DownSpeedbuttonCLICK
SHOWHINT = True
PARENTSHOWHINT = False
LEFT = 265
HEIGHT = 25
HINT = 'Move Down'
TOP = 165
WIDTH = 25
end
object OkButton: TBUTTON
ANCHORS = [akright, akbottom]
CAPTION = 'Ok'
TABSTOP = True
ONCLICK = OkButtonCLICK
LEFT = 120
HEIGHT = 25
TOP = 350
WIDTH = 75
end
object CancelButton: TBUTTON
ANCHORS = [akright, akbottom]
MODALRESULT = 2
CAPTION = 'Cancel'
TABSTOP = True
TABORDER = 1
LEFT = 216
HEIGHT = 25
TOP = 350
WIDTH = 75
end
object ItemTreeview: TTREEVIEW
ANCHORS = [aktop, akleft, akright, akbottom]
BACKGROUNDCOLOR = 16777215
BORDERWIDTH = 2
DEFAULTITEMHEIGHT = 17
DRAGCURSOR = 0
HIDESELECTION = False
INDENT = 15
PARENTCTL3D = False
RIGHTCLICKSELECT = True
SELECTIONCOLOR = -2147483635
TABORDER = 2
OPTIONS = [tvoautoitemheight, tvokeepcollapsednodes, tvorightclickselect, tvoshowbuttons, tvoshowlines, tvoshowroot, tvotooltips]
LEFT = 9
HEIGHT = 304
TOP = 8
WIDTH = 238
end
object ShowOldValuesCheckbox: TCHECKBOX
ALLOWGRAYED = True
ANCHORS = [akleft, akbottom]
AUTOSIZE = True
CAPTION = 'ShowOldValuesCheckbox'
DRAGCURSOR = 0
ONCLICK = ShowOldValuesCheckboxCLICK
TABORDER = 3
TABSTOP = True
LEFT = 15
HEIGHT = 20
TOP = 320
WIDTH = 171
end
object Imagelist1: TIMAGELIST
left = 56
top = 260
end
end

32
designer/taborderdlg.lrs Normal file
View File

@ -0,0 +1,32 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TTabOrderDialog','FORMDATA',[
'TPF0'#15'TTabOrderDialog'#14'TabOrderDialog'#7'CAPTION'#6#14'TabOrderDialog'
+#12'CLIENTHEIGHT'#3#131#1#11'CLIENTWIDTH'#3'6'#1#7'ONCLOSE'#7#19'TabOrderDia'
+'logCLOSE'#8'ONCREATE'#7#20'TabOrderDialogCREATE'#18'HORZSCROLLBAR.PAGE'#3'7'
+#1#18'VERTSCROLLBAR.PAGE'#3#132#1#4'LEFT'#3'}'#1#6'HEIGHT'#3#131#1#3'TOP'#3
+#167#0#5'WIDTH'#3'6'#1#0#12'TSPEEDBUTTON'#13'UpSpeedbutton'#7'ANCHORS'#11#5
+'aktop'#7'akright'#0#9'NUMGLYPHS'#2#0#7'ONCLICK'#7#18'UpSpeedbuttonCLICK'#8
+'SHOWHINT'#9#14'PARENTSHOWHINT'#8#4'LEFT'#3#9#1#6'HEIGHT'#2#25#4'HINT'#6#7'M'
+'ove Up'#3'TOP'#2'w'#5'WIDTH'#2#25#0#0#12'TSPEEDBUTTON'#15'DownSpeedbutton'#7
+'ANCHORS'#11#5'aktop'#7'akright'#0#9'NUMGLYPHS'#2#0#7'ONCLICK'#7#20'DownSpee'
+'dbuttonCLICK'#8'SHOWHINT'#9#14'PARENTSHOWHINT'#8#4'LEFT'#3#9#1#6'HEIGHT'#2
+#25#4'HINT'#6#9'Move Down'#3'TOP'#3#165#0#5'WIDTH'#2#25#0#0#7'TBUTTON'#8'OkB'
+'utton'#7'ANCHORS'#11#7'akright'#8'akbottom'#0#7'CAPTION'#6#2'Ok'#7'TABSTOP'
+#9#7'ONCLICK'#7#13'OkButtonCLICK'#4'LEFT'#2'x'#6'HEIGHT'#2#25#3'TOP'#3'^'#1#5
+'WIDTH'#2'K'#0#0#7'TBUTTON'#12'CancelButton'#7'ANCHORS'#11#7'akright'#8'akbo'
+'ttom'#0#11'MODALRESULT'#2#2#7'CAPTION'#6#6'Cancel'#7'TABSTOP'#9#8'TABORDER'
+#2#1#4'LEFT'#3#216#0#6'HEIGHT'#2#25#3'TOP'#3'^'#1#5'WIDTH'#2'K'#0#0#9'TTREEV'
+'IEW'#12'ItemTreeview'#7'ANCHORS'#11#5'aktop'#6'akleft'#7'akright'#8'akbotto'
+'m'#0#15'BACKGROUNDCOLOR'#4#255#255#255#0#11'BORDERWIDTH'#2#2#17'DEFAULTITEM'
+'HEIGHT'#2#17#10'DRAGCURSOR'#2#0#13'HIDESELECTION'#8#6'INDENT'#2#15#11'PAREN'
+'TCTL3D'#8#16'RIGHTCLICKSELECT'#9#14'SELECTIONCOLOR'#4#13#0#0#128#8'TABORDER'
+#2#2#7'OPTIONS'#11#17'tvoautoitemheight'#21'tvokeepcollapsednodes'#19'tvorig'
+'htclickselect'#14'tvoshowbuttons'#12'tvoshowlines'#11'tvoshowroot'#11'tvoto'
+'oltips'#0#4'LEFT'#2#9#6'HEIGHT'#3'0'#1#3'TOP'#2#8#5'WIDTH'#3#238#0#0#0#9'TC'
+'HECKBOX'#21'ShowOldValuesCheckbox'#11'ALLOWGRAYED'#9#7'ANCHORS'#11#6'akleft'
+#8'akbottom'#0#8'AUTOSIZE'#9#7'CAPTION'#6#21'ShowOldValuesCheckbox'#10'DRAGC'
+'URSOR'#2#0#7'ONCLICK'#7#26'ShowOldValuesCheckboxCLICK'#8'TABORDER'#2#3#7'TA'
+'BSTOP'#9#4'LEFT'#2#15#6'HEIGHT'#2#20#3'TOP'#3'@'#1#5'WIDTH'#3#171#0#0#0#10
+'TIMAGELIST'#10'Imagelist1'#4'left'#2'8'#3'top'#3#4#1#0#0#0
]);

201
designer/taborderdlg.pas Normal file
View File

@ -0,0 +1,201 @@
unit TabOrderDlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
ComCtrls, StdCtrls;
type
TTabOrderDialog = class(TForm)
ShowOldValuesCheckbox: TCHECKBOX;
Imagelist1: TIMAGELIST;
OkButton: TBUTTON;
CancelButton: TBUTTON;
ItemTreeview: TTREEVIEW;
UpSpeedbutton: TSPEEDBUTTON;
DownSpeedbutton: TSPEEDBUTTON;
procedure DownSpeedbuttonCLICK(Sender: TObject);
procedure OkButtonCLICK(Sender: TObject);
procedure ShowOldValuesCheckboxCLICK(Sender: TObject);
procedure TabOrderDialogCLOSE(Sender: TObject; var Action: TCloseAction);
procedure TabOrderDialogCREATE(Sender: TObject);
procedure UpSpeedbuttonCLICK(Sender: TObject);
private
FLookupRoot: TComponent;
procedure SetLookupRoot(const AValue: TComponent);
procedure CommitNodes(ANode: TTreeNode; var TabChanged: boolean);
procedure CreateNodes(ParentControl: TWinControl; ParentNode: TTreeNode);
public
procedure FillTree;
procedure ClearTree;
public
property LookupRoot: TComponent read FLookupRoot write SetLookupRoot;
end;
function ShowTabOrderDialog(LookupRoot: TComponent): TModalresult;
implementation
function ShowTabOrderDialog(LookupRoot: TComponent): TModalresult;
var
TabOrderDialog: TTabOrderDialog;
begin
TabOrderDialog:=TTabOrderDialog.Create(Application);
TabOrderDialog.LookupRoot:=LookupRoot;
Result:=TabOrderDialog.ShowModal;
TabOrderDialog.Free;
end;
{ TTabOrderDialog }
procedure TTabOrderDialog.TabOrderDialogCREATE(Sender: TObject);
begin
OkButton.Caption:='Ok';
CancelButton.Caption:='Cancel';
ShowOldValuesCheckbox.Caption:='Show old tab order';
UpSpeedbutton.Glyph:=TPixmap.Create;
UpSpeedbutton.Glyph.LoadFromLazarusResource('uparrow');
DownSpeedbutton.Glyph:=TPixmap.Create;
DownSpeedbutton.Glyph.LoadFromLazarusResource('downarrow');
end;
procedure TTabOrderDialog.UpSpeedbuttonCLICK(Sender: TObject);
var
CurItem: TTreeNode;
begin
CurItem:=ItemTreeview.Selected;
if (CurItem=nil) or (CurItem.GetPrevSibling=nil) then exit;
CurItem.MoveTo(CurItem.GetPrevSibling,naInsert);
ItemTreeview.Selected:=CurItem;
end;
procedure TTabOrderDialog.TabOrderDialogCLOSE(Sender: TObject;
var Action: TCloseAction);
begin
FLookupRoot:=nil;
end;
procedure TTabOrderDialog.ShowOldValuesCheckboxCLICK(Sender: TObject);
begin
FillTree;
end;
procedure TTabOrderDialog.DownSpeedbuttonCLICK(Sender: TObject);
var
CurItem: TTreeNode;
begin
CurItem:=ItemTreeview.Selected;
if (CurItem=nil) or (CurItem.GetNextSibling=nil) then exit;
CurItem.MoveTo(CurItem.GetNextSibling,naInsertBehind);
ItemTreeview.Selected:=CurItem;
end;
procedure TTabOrderDialog.OkButtonCLICK(Sender: TObject);
var
TabChanged: Boolean;
begin
TabChanged:=false;
CommitNodes(ItemTreeview.Items.GetFirstNode,TabChanged);
if TabChanged then
ModalResult:=mrOk
else
ModalResult:=mrCancel;
end;
procedure TTabOrderDialog.SetLookupRoot(const AValue: TComponent);
begin
if FLookupRoot=AValue then exit;
FLookupRoot:=AValue;
if FLookupRoot<>nil then begin
Caption:='Tab Order of '+FLookupRoot.Name;
end;
FillTree;
end;
procedure TTabOrderDialog.CommitNodes(ANode: TTreeNode;
var TabChanged: boolean);
var
AControl: TControl;
CurTabOrder: Integer;
begin
CurTabOrder:=0;
while ANode<>nil do begin
AControl:=TControl(ANode.Data);
if AControl.TabStop then begin
if AControl.TabOrder<>CurTabOrder then
TabChanged:=true;
AControl.TabOrder:=CurTabOrder;
writeln('TTabOrderDialog.CommitNodes A ',AControl.Name,' ',AControl.TabOrder,' ',CurTabOrder);
inc(CurTabOrder);
end;
CommitNodes(ANode.GetFirstChild,TabChanged);
ANode:=ANode.GetNextSibling;
end;
end;
procedure TTabOrderDialog.FillTree;
var
AControl: TWinControl;
begin
ItemTreeview.BeginUpdate;
try
ClearTree;
if (FLookupRoot=nil) or (not (FLookupRoot is TWinControl)) then exit;
AControl:=TWinControl(FLookupRoot);
CreateNodes(AControl,nil);
finally
ItemTreeview.EndUpdate;
end;
end;
procedure TTabOrderDialog.ClearTree;
begin
ItemTreeview.Items.Clear;
end;
procedure TTabOrderDialog.CreateNodes(ParentControl: TWinControl;
ParentNode: TTreeNode);
var
i: Integer;
AControl: TControl;
CurTab: Integer;
FirstSibling: TTreeNode;
NodeBehind: TTreeNode;
NewNode: TTreeNode;
NodeText: String;
begin
if ParentNode=nil then
FirstSibling:=nil
else
FirstSibling:=ParentNode.GetFirstChild;
for i:=0 to ParentControl.ControlCount-1 do begin
AControl:=ParentControl.Controls[i];
if not (AControl is TWinControl) then continue;
CurTab:=AControl.TabOrder;
NodeBehind:=FirstSibling;
while (NodeBehind<>nil) and (TControl(NodeBehind.Data).TabOrder<=CurTab)
do
NodeBehind:=NodeBehind.GetNextSibling;
NodeText:=AControl.Name;
if ShowOldValuesCheckbox.Checked then
NodeText:=NodeText+' ('+IntToStr(AControl.TabOrder)+')';
if NodeBehind<>nil then
NewNode:=ItemTreeview.Items.InsertObject(NodeBehind,NodeText,AControl)
else
NewNode:=ItemTreeview.Items.AddChildObject(ParentNode,NodeText,AControl);
if FirstSibling=nil then
FirstSibling:=NewNode;
if AControl is TWinControl then
CreateNodes(TWinControl(AControl),NewNode);
NewNode.Expanded:=true;
end;
end;
initialization
{$I taborderdlg.lrs}
end.

5
lcl/include/wincontrol.inc
View File

@ -1067,7 +1067,7 @@ end;
{------------------------------------------------------------------------------}
{ TWinControl IsControlMouseMsg }
{------------------------------------------------------------------------------}
function TWinControl.IsControlMouseMsg(var TheMessage : TLMMouse) : Boolean;
function TWinControl.IsControlMouseMsg(var TheMessage: TLMMouse) : Boolean;
var
Control : TControl;
P : TPoint;
@ -2800,6 +2800,9 @@ end;
{ =============================================================================
$Log$
Revision 1.137 2003/06/18 11:21:06 mattias
fixed taborder=0, implemented TabOrder Editor
Revision 1.136 2003/06/12 18:55:44 mattias
improved designer to recognize auto child moves