Inhalt

Aktueller Ordner: duesseldorfer-schuelerinventar-freepascal-client
⬅ Übergeordnet

u_profiledetail.pas

unit u_profiledetail;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  ComCtrls, Grids, fpjson, u_norms, u_chart;

type

  { TProfileDetailForm }

  TProfileDetailForm = class(TForm)
    btnClose: TButton;
    PageControl1: TPageControl;
    TabSE: TTabSheet;
    TabFE: TTabSheet;
    TabStats: TTabSheet;
    TabItems: TTabSheet;
    rgNorm: TRadioGroup;
    lblName: TLabel;
    sgSE: TStringGrid;
    sgFE: TStringGrid;
    sgItems: TStringGrid;
    lblCorrelation: TLabel;
    lblAgreement: TLabel;
    memInterpretation: TMemo;
    chartSE: TProfileChart;
    chartFE: TProfileChart;
    chartStats: TProfileChart;
    procedure FormCreate(Sender: TObject);
    procedure rgNormClick(Sender: TObject);
  private
    FProfileData: TJSONObject;
    FSeItems: array[1..36] of Integer;
    FFeItems: array[1..36] of Integer;
    FSeSums: array[1..6] of Integer;
    FFeSums: array[1..6] of Integer;
    FSeValues: array[1..6] of Integer;
    FFeValues: array[1..6] of Integer;
    procedure LoadData;
    procedure CalculateSums;
    procedure CalculateProfileValues(const NormSE, NormFE: TNormValues);
    procedure UpdateTables;
    procedure UpdateCharts;
    procedure UpdateStatistics;
    procedure UpdateItemsTable;
    function CalculateCorrelation: Double;
    function CalculateAgreement: Double;
    function GetBewertung(Value: Integer): string;
  public
    constructor Create(AOwner: TComponent; ProfileData: TJSONObject);
  end;

implementation

{$R *.lfm}

{ TProfileDetailForm }

constructor TProfileDetailForm.Create(AOwner: TComponent; ProfileData: TJSONObject);
begin
  inherited Create(AOwner);
  FProfileData := ProfileData;
  Caption := 'Profil: ' + ProfileData.Get('name', 'Unbekannt');
  Width := 1000;
  Height := 750;
  Position := poScreenCenter;
  FormCreate(Self);
end;

procedure TProfileDetailForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  sgSE.ColCount := 6;
  sgSE.RowCount := 7;
  sgSE.FixedCols := 1;
  sgSE.FixedRows := 1;
  sgSE.Cells[0, 0] := 'Kompetenz';
  for i := 1 to 5 do
    sgSE.Cells[i, 0] := IntToStr(i);
  sgSE.Cells[0, 1] := 'Arbeitsverhalten';
  sgSE.Cells[0, 2] := 'Lernverhalten';
  sgSE.Cells[0, 3] := 'Sozialverhalten';
  sgSE.Cells[0, 4] := 'Fachkompetenz';
  sgSE.Cells[0, 5] := 'Personale Kompetenz';
  sgSE.Cells[0, 6] := 'Methodenkompetenz';
  sgSE.DefaultRowHeight := 25;
  
  sgFE.ColCount := 6;
  sgFE.RowCount := 7;
  sgFE.FixedCols := 1;
  sgFE.FixedRows := 1;
  sgFE.Cells[0, 0] := 'Kompetenz';
  for i := 1 to 5 do
    sgFE.Cells[i, 0] := IntToStr(i);
  for i := 1 to 6 do
    sgFE.Cells[0, i] := sgSE.Cells[0, i];
  sgFE.DefaultRowHeight := 25;
  
  sgItems.ColCount := 3;
  sgItems.RowCount := 37;
  sgItems.FixedCols := 1;
  sgItems.FixedRows := 1;
  sgItems.Cells[0, 0] := 'Item';
  sgItems.Cells[1, 0] := 'SE';
  sgItems.Cells[2, 0] := 'FE';
  for i := 1 to 36 do
    sgItems.Cells[0, i] := ITEMS[i];
  sgItems.ColWidths[0] := 250;
  sgItems.ColWidths[1] := 50;
  sgItems.ColWidths[2] := 50;
  
  rgNorm.Items.Clear;
  rgNorm.Items.Add('Hauptschule (HS)');
  rgNorm.Items.Add('Förderschule (FS)');
  rgNorm.ItemIndex := 0;
  
  LoadData;
end;

procedure TProfileDetailForm.LoadData;
var
  i: Integer;
begin
  for i := 1 to 36 do
    FSeItems[i] := FProfileData.Get('item' + IntToStr(i), 2);
  for i := 1 to 36 do
    FFeItems[i] := FProfileData.Get('feitem' + IntToStr(i), 2);
    
  lblName.Caption := 'Name: ' + FProfileData.Get('name', '');
  
  CalculateSums;
  if rgNorm.ItemIndex = 0 then
    CalculateProfileValues(NORM_SE_HS, NORM_FE_HS)
  else
    CalculateProfileValues(NORM_SE_FS, NORM_FE_FS);
    
  UpdateTables;
  UpdateCharts;
  UpdateStatistics;
  UpdateItemsTable;
end;

procedure TProfileDetailForm.CalculateSums;
var
  i: Integer;
begin
  FSeSums[1] := 0; FFeSums[1] := 0;
  for i := 1 to 10 do
  begin
    FSeSums[1] := FSeSums[1] + FSeItems[i];
    FFeSums[1] := FFeSums[1] + FFeItems[i];
  end;
  
  FSeSums[2] := 0; FFeSums[2] := 0;
  for i := 11 to 20 do
  begin
    FSeSums[2] := FSeSums[2] + FSeItems[i];
    FFeSums[2] := FFeSums[2] + FFeItems[i];
  end;
  
  FSeSums[3] := 0; FFeSums[3] := 0;
  for i := 21 to 28 do
  begin
    FSeSums[3] := FSeSums[3] + FSeItems[i];
    FFeSums[3] := FFeSums[3] + FFeItems[i];
  end;
  FSeSums[3] := FSeSums[3] + FSeItems[9] + FSeItems[10];
  FFeSums[3] := FFeSums[3] + FFeItems[9] + FFeItems[10];
  
  FSeSums[4] := 0; FFeSums[4] := 0;
  for i := 29 to 36 do
  begin
    FSeSums[4] := FSeSums[4] + FSeItems[i];
    FFeSums[4] := FFeSums[4] + FFeItems[i];
  end;
  
  FSeSums[5] := FSeItems[1] + FSeItems[2] + FSeItems[6] + FSeItems[7] + FSeItems[8] +
                FSeItems[9] + FSeItems[10] + FSeItems[12] + FSeItems[13] + FSeItems[14] + FSeItems[15];
  FFeSums[5] := FFeItems[1] + FFeItems[2] + FFeItems[6] + FFeItems[7] + FFeItems[8] +
                FFeItems[9] + FFeItems[10] + FFeItems[12] + FFeItems[13] + FFeItems[14] + FFeItems[15];
  
  FSeSums[6] := FSeItems[3] + FSeItems[4] + FSeItems[5] + FSeItems[9] + FSeItems[10] +
                FSeItems[11] + FSeItems[17] + FSeItems[18];
  FFeSums[6] := FFeItems[3] + FFeItems[4] + FFeItems[5] + FFeItems[9] + FFeItems[10] +
                FFeItems[11] + FFeItems[17] + FFeItems[18];
end;

procedure TProfileDetailForm.CalculateProfileValues(const NormSE, NormFE: TNormValues);
var
  k, p: Integer;
begin
  for k := 1 to 6 do
  begin
    FSeValues[k] := 4;
    for p := 1 to 5 do
      if FSeSums[k] < NormSE[k, p] then
      begin
        FSeValues[k] := p - 1;
        Break;
      end;
      
    FFeValues[k] := 4;
    for p := 1 to 5 do
      if FFeSums[k] < NormFE[k, p] then
      begin
        FFeValues[k] := p - 1;
        Break;
      end;
  end;
end;

procedure TProfileDetailForm.UpdateTables;
var
  i, j: Integer;
begin
  for i := 1 to 6 do
    for j := 1 to 5 do
      if j - 1 = FSeValues[i] then
        sgSE.Cells[j, i] := 'X'
      else
        sgSE.Cells[j, i] := '';
        
  for i := 1 to 6 do
    for j := 1 to 5 do
      if j - 1 = FFeValues[i] then
        sgFE.Cells[j, i] := 'X'
      else
        sgFE.Cells[j, i] := '';
end;

procedure TProfileDetailForm.UpdateCharts;
var
  seChartValues: array[1..6] of Double;
  feChartValues: array[1..6] of Double;
  i: Integer;
begin
  for i := 1 to 6 do
  begin
    seChartValues[i] := FSeValues[i] + 1;
    feChartValues[i] := FFeValues[i] + 1;
  end;
  
  chartSE.SetSeValues(seChartValues[1], seChartValues[2], seChartValues[3],
                      seChartValues[4], seChartValues[5], seChartValues[6]);
  chartSE.SetFEValues(0, 0, 0, 0, 0, 0);
  
  chartFE.SetFEValues(feChartValues[1], feChartValues[2], feChartValues[3],
                      feChartValues[4], feChartValues[5], feChartValues[6]);
  chartFE.SetSeValues(0, 0, 0, 0, 0, 0);
  
  chartStats.SetSeValues(seChartValues[1], seChartValues[2], seChartValues[3],
                         seChartValues[4], seChartValues[5], seChartValues[6]);
  chartStats.SetFEValues(feChartValues[1], feChartValues[2], feChartValues[3],
                         feChartValues[4], feChartValues[5], feChartValues[6]);
end;

procedure TProfileDetailForm.UpdateStatistics;
var
  corr: Double;
  agree: Double;
  i: Integer;
  seVals: array[1..6] of Integer;
  feVals: array[1..6] of Integer;
begin
  for i := 1 to 6 do
  begin
    seVals[i] := FSeValues[i] + 1;
    feVals[i] := FFeValues[i] + 1;
  end;
  
  corr := CalculateCorrelation;
  agree := CalculateAgreement;
  
  lblCorrelation.Caption := Format('Korrelation: %.2f', [corr]);
  lblAgreement.Caption := Format('Übereinstimmung: %.1f%%', [agree]);
  
  memInterpretation.Clear;
  memInterpretation.Lines.Add('Die Korrelation von ' + Format('%.2f', [corr]) + ' bedeutet:');
  if corr >= 0.8 then
    memInterpretation.Lines.Add('  Sehr gute Übereinstimmung zwischen Selbst- und Fremdeinschätzung.')
  else if corr >= 0.5 then
    memInterpretation.Lines.Add('  Mäßige Übereinstimmung zwischen Selbst- und Fremdeinschätzung.')
  else if corr >= 0.3 then
    memInterpretation.Lines.Add('  Schwache Übereinstimmung zwischen Selbst- und Fremdeinschätzung.')
  else
    memInterpretation.Lines.Add('  Keine signifikante Übereinstimmung zwischen Selbst- und Fremdeinschätzung.');
    
  memInterpretation.Lines.Add('');
  memInterpretation.Lines.Add('Auswertung der Kompetenzen:');
  memInterpretation.Lines.Add(StringOfChar('-', 50));
  memInterpretation.Lines.Add('Selbsteinschätzung:');
  for i := 1 to 6 do
    memInterpretation.Lines.Add(Format('  • %s: %s', [KOMPETENZEN[i], GetBewertung(seVals[i])]));
  memInterpretation.Lines.Add('');
  memInterpretation.Lines.Add('Fremdeinschätzung:');
  for i := 1 to 6 do
    memInterpretation.Lines.Add(Format('  • %s: %s', [KOMPETENZEN[i], GetBewertung(feVals[i])]));
end;

procedure TProfileDetailForm.UpdateItemsTable;
var
  i: Integer;
begin
  for i := 1 to 36 do
  begin
    sgItems.Cells[1, i] := IntToStr(FSeItems[i]);
    sgItems.Cells[2, i] := IntToStr(FFeItems[i]);
  end;
end;

function TProfileDetailForm.CalculateCorrelation: Double;
var
  i: Integer;
  seMean, feMean: Double;
  seVals: array[1..6] of Double;
  feVals: array[1..6] of Double;
  numerator, seVar, feVar: Double;
begin
  for i := 1 to 6 do
  begin
    seVals[i] := FSeValues[i] + 1;
    feVals[i] := FFeValues[i] + 1;
  end;
  
  seMean := (seVals[1] + seVals[2] + seVals[3] + seVals[4] + seVals[5] + seVals[6]) / 6;
  feMean := (feVals[1] + feVals[2] + feVals[3] + feVals[4] + feVals[5] + feVals[6]) / 6;
  
  numerator := 0;
  seVar := 0;
  feVar := 0;
  
  for i := 1 to 6 do
  begin
    numerator := numerator + (seVals[i] - seMean) * (feVals[i] - feMean);
    seVar := seVar + Sqr(seVals[i] - seMean);
    feVar := feVar + Sqr(feVals[i] - feMean);
  end;
  
  if (seVar = 0) or (feVar = 0) then
    Result := 0
  else
    Result := numerator / Sqrt(seVar * feVar);
end;

function TProfileDetailForm.CalculateAgreement: Double;
var
  i, matches: Integer;
begin
  matches := 0;
  for i := 1 to 36 do
    if FSeItems[i] = FFeItems[i] then
      Inc(matches);
  Result := matches * 100 / 36;
end;

function TProfileDetailForm.GetBewertung(Value: Integer): string;
begin
  case Value of
    1: Result := 'weit unterdurchschnittlich';
    2: Result := 'unterdurchschnittlich';
    3: Result := 'durchschnittlich';
    4: Result := 'überdurchschnittlich';
    5: Result := 'weit überdurchschnittlich';
  else
    Result := 'unbekannt';
  end;
end;

procedure TProfileDetailForm.rgNormClick(Sender: TObject);
begin
  if rgNorm.ItemIndex = 0 then
    CalculateProfileValues(NORM_SE_HS, NORM_FE_HS)
  else
    CalculateProfileValues(NORM_SE_FS, NORM_FE_FS);
  UpdateTables;
  UpdateCharts;
  UpdateStatistics;
end;

end.