pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazStats: Inherit form of CrossTabUnit from TBasicStatsReportForm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7748 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-10-05 20:12:22 +00:00
parent 6eb21d1873
commit d16c17ff86
2 changed files with 61 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
applications/lazstats/source/forms/analysis/descriptive/crosstabunit.lfm
View File

@ -8,101 +8,36 @@ inherited CrossTabFrm: TCrossTabFrm
Caption = 'Cross Tabulation' Caption = 'Cross Tabulation'
ClientHeight = 358 ClientHeight = 358
ClientWidth = 879 ClientWidth = 879
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate
Position = poMainFormCenter
object ParamsPanel: TPanel[0]
Left = 8
Height = 342 Height = 342
Top = 8
Width = 320 Width = 320
Align = alLeft
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 4
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 342 ClientHeight = 342
ClientWidth = 320 ClientWidth = 320
TabOrder = 0 inherited CloseBtn: TButton
object Bevel2: TBevel
AnchorSideLeft.Control = ParamsPanel
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 301
Width = 320
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object CloseBtn: TButton
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ParamsPanel
AnchorSideBottom.Side = asrBottom
Left = 265 Left = 265
Height = 25
Top = 317 Top = 317
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Close'
ModalResult = 11
OnClick = CloseBtnClick
TabOrder = 7 TabOrder = 7
end end
object ResetBtn: TButton inherited ComputeBtn: TButton
AnchorSideTop.Control = CloseBtn Left = 182
AnchorSideRight.Control = ComputeBtn
Left = 119
Height = 25
Top = 317 Top = 317
Width = 54
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 5
end
object HelpBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = ResetBtn
Left = 60
Height = 25
Top = 317
Width = 51
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Right = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 4
end
object ComputeBtn: TButton
AnchorSideTop.Control = CloseBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 181
Height = 25
Top = 317
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 6 TabOrder = 6
end end
object Label1: TLabel inherited ResetBtn: TButton
Left = 120
Top = 317
TabOrder = 5
end
inherited HelpBtn: TButton
Left = 61
Top = 317
TabOrder = 4
end
inherited ButtonBevel: TBevel
Top = 301
Width = 320
end
object Label1: TLabel[5]
AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel AnchorSideTop.Control = ParamsPanel
Left = 0 Left = 0
@ -112,7 +47,7 @@ inherited CrossTabFrm: TCrossTabFrm
Caption = 'Available Variables' Caption = 'Available Variables'
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel[6]
AnchorSideLeft.Control = SelList AnchorSideLeft.Control = SelList
Left = 182 Left = 182
Height = 15 Height = 15
@ -121,12 +56,12 @@ inherited CrossTabFrm: TCrossTabFrm
Caption = 'Variables to Analyze' Caption = 'Variables to Analyze'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[7]
AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = InBtn AnchorSideRight.Control = InBtn
AnchorSideBottom.Control = Bevel2 AnchorSideBottom.Control = ButtonBevel
Left = 0 Left = 0
Height = 284 Height = 284
Top = 17 Top = 17
@ -140,7 +75,7 @@ inherited CrossTabFrm: TCrossTabFrm
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object SelList: TListBox object SelList: TListBox[8]
AnchorSideLeft.Control = InBtn AnchorSideLeft.Control = InBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2 AnchorSideTop.Control = Label2
@ -161,7 +96,7 @@ inherited CrossTabFrm: TCrossTabFrm
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
object InBtn: TBitBtn object InBtn: TBitBtn[9]
AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = VertCenterBevel AnchorSideBottom.Control = VertCenterBevel
@ -176,7 +111,7 @@ inherited CrossTabFrm: TCrossTabFrm
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 1
end end
object OutBtn: TBitBtn object OutBtn: TBitBtn[10]
AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VertCenterBevel AnchorSideTop.Control = VertCenterBevel
@ -193,7 +128,7 @@ inherited CrossTabFrm: TCrossTabFrm
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 2
end end
object VertCenterBevel: TBevel object VertCenterBevel: TBevel[11]
AnchorSideLeft.Control = InBtn AnchorSideLeft.Control = InBtn
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
@ -207,28 +142,8 @@ inherited CrossTabFrm: TCrossTabFrm
Shape = bsSpacer Shape = bsSpacer
end end
end end
object ParamsSplitter: TSplitter[1] inherited ParamsSplitter: TSplitter
Left = 332 Left = 332
Height = 358 Height = 358
Top = 0
Width = 5
ResizeStyle = rsPattern
end
object PageControl: TPageControl[2]
Left = 341
Height = 342
Top = 8
Width = 530
ActivePage = ReportPage
Align = alClient
BorderSpacing.Left = 4
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
TabIndex = 0
TabOrder = 2
object ReportPage: TTabSheet
Caption = 'Report'
end
end end
end end

120
applications/lazstats/source/forms/analysis/descriptive/crosstabunit.pas
View File

@ -9,49 +9,36 @@ interface
uses uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, ComCtrls, StdCtrls, Buttons, ExtCtrls, ComCtrls,
Globals, MainUnit, DataProcs, MatrixLib, ContextHelpUnit, Globals, MainUnit, MatrixLib, ReportFrameUnit, BasicStatsReportFormUnit;
BasicStatsFormUnit, ReportFrameUnit;
type type
{ TCrossTabFrm } { TCrossTabFrm }
TCrossTabFrm = class(TBasicStatsForm) TCrossTabFrm = class(TBasicStatsReportForm)
ComputeBtn: TButton;
PageControl: TPageControl;
ParamsPanel: TPanel;
ParamsSplitter: TSplitter;
ReportPage: TTabSheet;
VertCenterBevel: TBevel; VertCenterBevel: TBevel;
Bevel2: TBevel;
HelpBtn: TButton;
InBtn: TBitBtn; InBtn: TBitBtn;
OutBtn: TBitBtn; OutBtn: TBitBtn;
ResetBtn: TButton;
CloseBtn: TButton;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
VarList: TListBox; VarList: TListBox;
SelList: TListBox; SelList: TListBox;
procedure CloseBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure InBtnClick(Sender: TObject); procedure InBtnClick(Sender: TObject);
procedure OutBtnClick(Sender: TObject); procedure OutBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure SelListDblClick(Sender: TObject); procedure SelListDblClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject); procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private private
FReportFrame: TReportFrame;
FAutosized: Boolean;
procedure Prepare(out AVarList, AColNoSelected: IntDyneVec); procedure Prepare(out AVarList, AColNoSelected: IntDyneVec);
procedure UpdateBtnStates;
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
public public
constructor Create(AOwner: TComponent); override;
procedure Reset; override; procedure Reset; override;
end; end;
@ -73,10 +60,10 @@ uses
type type
TCrossTabCalculator = class TCrossTabCalculator = class
private private
FReport: TStrings;
FVarList: IntDyneVec;
FDataGrid: TStringGrid; FDataGrid: TStringGrid;
FColNoSelected: IntDyneVec; FColNoSelected: IntDyneVec;
FVarList: IntDyneVec;
FReport: TStrings;
grandsum, sum, index: integer; grandsum, sum, index: integer;
no_in_list, length_array: integer; no_in_list, length_array: integer;
@ -315,19 +302,35 @@ end;
{ TCrossTabFrm } { TCrossTabFrm }
procedure TCrossTabFrm.CloseBtnClick(Sender: TObject); constructor TCrossTabFrm.Create(AOwner: TComponent);
begin begin
Close; inherited;
end; end;
procedure TCrossTabFrm.ComputeBtnClick(Sender: TObject); procedure TCrossTabFrm.AdjustConstraints;
begin
inherited;
ParamsPanel.Constraints.MinWidth := Max(
4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
Max(Label1.Width, Label2.Width) + InBtn.Width + VarList.BorderSpacing.Right * 2
);
ParamsPanel.Constraints.MinHeight := 200;
Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300;;
Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + 2*ParamsPanel.BorderSpacing.Top;
end;
procedure TCrossTabFrm.Compute;
var var
lReport: TStringList; lReport: TStringList;
calculator: TCrossTabCalculator; calculator: TCrossTabCalculator;
var_list: IntDyneVec = nil; var_list: IntDyneVec = nil;
colNoSelected: IntDyneVec = nil; colNoSelected: IntDyneVec = nil;
begin begin
inherited;
if SelList.Items.Count = 0 then if SelList.Items.Count = 0 then
begin begin
ErrorMsg('No variables selected for analysis.'); ErrorMsg('No variables selected for analysis.');
@ -355,60 +358,6 @@ begin
end; end;
procedure TCrossTabFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
ParamsPanel.Constraints.MinWidth := Max(
4*w + 3*CloseBtn.BorderSpacing.Left,
Max(Label1.Width, Label2.Width) + InBtn.Width + VarList.BorderSpacing.Right * 2
);
ParamsPanel.Constraints.MinHeight := 200;
Constraints.MinWidth := ParamsPanel.Constraints.MinWidth + 300;;
Constraints.MinHeight := ParamsPanel.Constraints.MinHeight + 2*ParamsPanel.BorderSpacing.Top;
if Width < Constraints.MinWidth then Width := 1; // enforce constraints
if Height < Constraints.MinHeight then Height := 1;
Position := poDesigned;
FAutoSized := true;
end;
procedure TCrossTabFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
InitForm(self);
FReportFrame := TReportFrame.Create(self);
with FReportFrame do
begin
Parent := ReportPage;
Align := alClient;
end;
Reset;
end;
procedure TCrossTabFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TCrossTabFrm.InBtnClick(Sender: TObject); procedure TCrossTabFrm.InBtnClick(Sender: TObject);
var var
i: integer; i: integer;
@ -489,13 +438,9 @@ begin
for i := 1 to NoVariables do for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates; UpdateBtnStates;
FReportFrame.Clear;
end;
if FReportFrame <> nil then
procedure TCrossTabFrm.ResetBtnClick(Sender: TObject); FReportFrame.Clear;
begin
Reset;
end; end;
@ -536,7 +481,8 @@ begin
end; end;
OutBtn.Enabled := lSelected; OutBtn.Enabled := lSelected;
FReportFrame.UpdateBtnStates; if FReportFrame <> nil then
FReportFrame.UpdateBtnStates;
end; end;