unit SortCasesUnit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons, MainUnit, OutPutUnit, FunctionsLib, Globals, DataProcs, DictionaryUnit; type { TSortCasesFrm } TSortCasesFrm = class(TForm) VarInBtn: TBitBtn; VarOutBtn: TBitBtn; CancelBtn: TButton; ComputeBtn: TButton; ReturnBtn: TButton; OrderGroup: TRadioGroup; SortVarEdit: TEdit; Label1: TLabel; Label2: TLabel; VarList: TListBox; procedure ComputeBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure VarInBtnClick(Sender: TObject); procedure VarOutBtnClick(Sender: TObject); private { private declarations } public { public declarations } end; var SortCasesFrm: TSortCasesFrm; implementation { TSortCasesFrm } procedure TSortCasesFrm.FormShow(Sender: TObject); VAR i : integer; begin SortVarEdit.Text := ''; VarOutBtn.Visible := false; VarInBtn.Visible := true; VarList.Items.Clear; for i := 1 to NoVariables do VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); end; procedure TSortCasesFrm.ComputeBtnClick(Sender: TObject); label strvals, lastplace; var temp : string; i, j, k : integer; selcol : integer; begin selcol := 0; for i := 1 to NoVariables do if OS3MainFrm.DataGrid.Cells[i,0] = SortVarEdit.Text then selcol := i; if DictionaryFrm.DictGrid.Cells[4,selcol] = 'S' then goto strvals; if selcol > 0 then begin if OrderGroup.ItemIndex = 0 then // sort ascending begin for i := 1 to NoCases-1 do begin for j := i+1 to NoCases do begin if StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,i])) > StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,j])) then begin for k := 1 to NoVariables do begin temp := OS3MainFrm.DataGrid.Cells[k,i]; OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; OS3MainFrm.DataGrid.Cells[k,j] := temp; end; end; end; // next j end; // next i end // if ascending sort else begin // descending sort for i := 1 to NoCases-1 do begin for j := i+1 to NoCases do begin if StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,i])) < StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[selcol,j])) then begin for k := 1 to NoVariables do begin temp := OS3MainFrm.DataGrid.Cells[k,i]; OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; OS3MainFrm.DataGrid.Cells[k,j] := temp; end; end; end; // next j end; // next i end; // if descending sort end; // if selcol > 0 goto lastplace; strvals: if selcol > 0 then begin if OrderGroup.ItemIndex = 0 then // sort ascending begin for i := 1 to NoCases-1 do begin for j := i+1 to NoCases do begin if Trim(OS3MainFrm.DataGrid.Cells[selcol,i]) > Trim(OS3MainFrm.DataGrid.Cells[selcol,j]) then begin for k := 1 to NoVariables do begin temp := OS3MainFrm.DataGrid.Cells[k,i]; OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; OS3MainFrm.DataGrid.Cells[k,j] := temp; end; end; end; // next j end; // next i end // if ascending sort else begin // descending sort for i := 1 to NoCases-1 do begin for j := i+1 to NoCases do begin if Trim(OS3MainFrm.DataGrid.Cells[selcol,i]) < Trim(OS3MainFrm.DataGrid.Cells[selcol,j]) then begin for k := 1 to NoVariables do begin temp := OS3MainFrm.DataGrid.Cells[k,i]; OS3MainFrm.DataGrid.Cells[k,i] := OS3MainFrm.DataGrid.Cells[k,j]; OS3MainFrm.DataGrid.Cells[k,j] := temp; end; end; end; // next j end; // next i end; // if descending sort end; // if selcol > 0 lastplace: end; procedure TSortCasesFrm.VarInBtnClick(Sender: TObject); VAR i : integer; begin i := VarList.ItemIndex; if i < 0 then exit; SortVarEdit.Text := VarList.Items.Strings[i]; VarList.Items.Delete(i); VarInBtn.Visible := false; VarOutBtn.Visible := true; end; procedure TSortCasesFrm.VarOutBtnClick(Sender: TObject); begin if SortVarEdit.Text = '' then exit; VarList.Items.Add(SortVarEdit.Text); SortVarEdit.Text := ''; VarOutBtn.Visible := false; VarInBtn.Visible := true; end; initialization {$I sortcasesunit.lrs} end.