unit ZeiterfassungMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Grids, Wwdbigrd, Wwdbgrid, ExtCtrls, DBCtrls, StdCtrls;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
wwDBGrid1: TwwDBGrid;
ADOTable1: TADOTable;
DataSource1: TDataSource;
ADOTable1TAG: TWideStringField;
ADOTable1KOMMEN: TWideStringField;
ADOTable1PAUSE_START: TWideStringField;
ADOTable1PAUSE_ENDE: TWideStringField;
ADOTable1GEHEN: TWideStringField;
ADOTable1SONSTIGER_ABZUG: TWideStringField;
ADOTable1ZUHAUSE: TWideStringField;
ADOTable1BERSTUNDEN_SALDO: TIntegerField;
ADOTable1BERSTUNDEN: TIntegerField;
ADOTable1FREIER_TAG: TBooleanField;
Panel1: TPanel;
Button1: TButton;
DBNavigator1: TDBNavigator;
ADOTable1WOCHENTAG: TStringField;
ADOTable1USERNAME: TStringField;
ComboBox1: TComboBox;
Label1: TLabel;
Label2: TLabel;
ADOTable1BEMERKUNG: TStringField;
procedure ADOTable1NewRecord(DataSet: TDataSet);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ADOTable1BeforePost(DataSet: TDataSet);
procedure ADOTable1BERSTUNDEN_SALDOGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1BERSTUNDENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure wwDBGrid1CalcCellColors(Sender: TObject; Field: TField;
State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush);
procedure ADOTable1AfterPost(DataSet: TDataSet);
procedure Button1Click(Sender: TObject);
procedure ADOTable1TAGChange(Sender: TField);
procedure ADOTable1SONSTIGER_ABZUGSetText(Sender: TField;
const Text: string);
procedure ADOTable1ZUHAUSESetText(Sender: TField; const Text: string);
procedure ADOTable1GEHENSetText(Sender: TField; const Text: string);
procedure ADOTable1PAUSE_ENDESetText(Sender: TField; const Text: string);
procedure ADOTable1PAUSE_STARTSetText(Sender: TField; const Text: string);
procedure ADOTable1KOMMENSetText(Sender: TField; const Text: string);
procedure FormShow(Sender: TObject);
procedure ADOTable1WOCHENTAGGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ComboBox1Change(Sender: TObject);
procedure ADOTable1TAGSetText(Sender: TField; const Text: string);
procedure ADOTable1AfterDelete(DataSet: TDataSet);
procedure ADOTable1TAGGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1KOMMENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1PAUSE_STARTGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1PAUSE_ENDEGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1GEHENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1SONSTIGER_ABZUGGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
procedure ADOTable1ZUHAUSEGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
private
function GueltigeZeile: boolean;
protected
procedure ReorgDataSet;
procedure ReorgAll;
function RegelArbeitszeit: integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// TODO: Trennstriche zwischen Wochen oder zwischen Urlauben
// IDEE: Wochenend-Multiplikator
uses
DateUtils, StrUtils, IniFiles;
{$REGION 'Hilfsfunktionen'}
function SQL_Escape(const s: string): string;
begin
result := StringReplace(s, '''', '\''', [rfReplaceAll]);
end;
function IstLeer(f: TField): boolean;
begin
result := f.IsNull or (f.AsString = '') or (f.AsString = '00:00:00');
end;
function Minuten(f: TField): integer;
begin
if IstLeer(f) then
begin
result := 0;
end
else
begin
result := MinuteOfTheDay(f.AsDateTime);
end;
end;
function MinutenZuHF_Int(min: integer): string;
var
d: integer;
begin
d := min;
if d < 0 then
begin
result := '-';
d := -d;
end
else
begin
result := '';
end;
result := result + Format('%.2d:%.2d', [d div 60, d mod 60]);
end;
function MinutenZuHF(f: TField): string;
begin
if IstLeer(f) then
begin
result := '';
end
else
begin
result := MinutenZuHF_Int(f.AsInteger);
end;
end;
function EchtesDatum(f: TField): TDate;
begin
if Copy(f.AsString, 5, 1) = '-' then
begin
result := EncodeDate(
StrtoInt(Copy(f.AsString, 1, 4)),
StrtoInt(Copy(f.AsString, 6, 2)),
StrtoInt(Copy(f.AsString, 9, 2))
);
end
else
result := StrToDate(f.AsString);
end;
function WUserName: String;
var
nSize: DWord;
begin
nSize := 1024;
SetLength(Result, nSize);
if GetUserName(PChar(Result), nSize) then
SetLength(Result, nSize-1)
else
RaiseLastOSError;
end;
{$ENDREGION}
function TForm1.RegelArbeitszeit: integer;
var
test: TADOQuery;
begin
test := TADOQuery.Create(nil);
try
test.Connection := ADOConnection1;
test.Close;
test.SQL.Text := 'select MINUTEN from REGELARBEITSZEIT where USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
test.Open;
if test.RecordCount = 0 then
begin
result := 8 * 60;
end
else
begin
result := test.FieldByName('MINUTEN').AsInteger;
end;
finally
test.Free;
end;
end;
procedure TForm1.ReorgAll;
var
saldo: integer;
baks: string;
bakEv: TDataSetNotifyEvent;
dead: boolean;
begin
if ADOTable1TAG.IsNull then
begin
baks := '';
end
else
begin
if Copy(ADOTable1TAG.AsString, 5, 1) = '-' then
baks := ADOTable1TAG.AsString
else
DateTimeToString(baks, 'YYYY-MM-DD', ADOTable1TAG.AsDateTime);
end;
ADOTable1.Requery();
bakEv := ADOTable1.AfterPost;
ADOTable1.AfterPost := nil;
ADOTable1.DisableControls;
try
ADOTable1.First;
saldo := 0;
dead := false;
while not ADOTable1.Eof do
begin
ADOTable1.Edit;
if not dead then ReorgDataSet;
dead := dead or ADOTable1BERSTUNDEN.IsNull;
if dead then
begin
ADOTable1BERSTUNDEN_SALDO.Clear;
end
else
begin
saldo := saldo + ADOTable1BERSTUNDEN.AsInteger;
ADOTable1BERSTUNDEN_SALDO.AsInteger := saldo;
saldo := ADOTable1BERSTUNDEN_SALDO.AsInteger;
end;
ADOTable1.Post;
ADOTable1.Next;
end;
finally
if baks <> '' then ADOTable1.Locate('USERNAME;TAG', VarArrayOf([WUserName, baks]), []);
ADOTable1.AfterPost := bakEv;
ADOTable1.EnableControls;
end;
end;
procedure TForm1.ADOTable1AfterDelete(DataSet: TDataSet);
begin
ReorgAll;
end;
procedure TForm1.ADOTable1AfterPost(DataSet: TDataSet);
begin
ReorgAll;
end;
function TForm1.GueltigeZeile: boolean;
begin
result := false;
if IstLeer(ADOTable1KOMMEN) <> IstLeer(ADOTable1GEHEN) then exit;
if IstLeer(ADOTable1PAUSE_START) <> IstLeer(ADOTable1PAUSE_ENDE) then exit;
if not IstLeer(ADOTable1PAUSE_START) and (ADOTable1PAUSE_START.AsDateTime < ADOTable1KOMMEN.AsDateTime) then exit;
if not IstLeer(ADOTable1PAUSE_ENDE) and (ADOTable1PAUSE_ENDE.AsDateTime < ADOTable1PAUSE_START.AsDateTime) then exit;
if not IstLeer(ADOTable1GEHEN) and (ADOTable1GEHEN.AsDateTime < ADOTable1KOMMEN.AsDateTime) then exit;
if not IstLeer(ADOTable1GEHEN) and not IstLeer(ADOTable1PAUSE_START) and (ADOTable1GEHEN.AsDateTime < ADOTable1PAUSE_START.AsDateTime) then exit;
if not IstLeer(ADOTable1GEHEN) and not IstLeer(ADOTable1PAUSE_ENDE) and (ADOTable1GEHEN.AsDateTime < ADOTable1PAUSE_ENDE.AsDateTime) then exit;
result := true;
end;
procedure TForm1.ReorgDataSet;
var
m: integer;
begin
if GueltigeZeile then
begin
m := (Minuten(ADOTable1GEHEN) - Minuten(ADOTable1KOMMEN))
- (Minuten(ADOTable1PAUSE_ENDE) - Minuten(ADOTable1PAUSE_START))
- Minuten(ADOTable1SONSTIGER_ABZUG)
+ Minuten(ADOTable1ZUHAUSE);
if not ADOTable1FREIER_TAG.AsBoolean then
begin
m := m - RegelArbeitszeit;
end;
ADOTable1BERSTUNDEN.AsInteger := m;
end
else
begin
ADOTable1BERSTUNDEN.Clear;
end;
end;
procedure TForm1.ADOTable1BeforePost(DataSet: TDataSet);
begin
if (ADOTable1.State = dsInsert) and ADOTable1TAG.IsNull then
begin
AdoTable1.Cancel;
Abort;
end;
ReorgDataSet;
end;
procedure TForm1.ADOTable1BERSTUNDENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := MinutenZuHF(ADOTable1BERSTUNDEN);
end;
procedure TForm1.ADOTable1BERSTUNDEN_SALDOGetText(Sender: TField;
var Text: string; DisplayText: Boolean);
begin
Text := MinutenZuHF(ADOTable1BERSTUNDEN_SALDO);
end;
procedure TForm1.ADOTable1GEHENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1GEHENSetText(Sender: TField; const Text: string);
begin
if Text = '' then
begin
ADOTable1GEHEN.Clear;
end
else
begin
ADOTable1GEHEN.AsString := Text;
end;
end;
procedure TForm1.ADOTable1KOMMENGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1KOMMENSetText(Sender: TField; const Text: string);
begin
if Text = '' then
begin
ADOTable1KOMMEN.Clear;
end
else
begin
ADOTable1KOMMEN.AsString := Text;
end;
end;
procedure TForm1.ADOTable1NewRecord(DataSet: TDataSet);
var
test: TADOQuery;
begin
ADOTable1FREIER_TAG.AsBoolean := false;
ADOTable1USERNAME.AsString := WUserName;
test := TADOQuery.Create(nil);
try
test.Connection := ADOConnection1;
test.Close;
test.SQL.Text := 'select * from TAGE where TAG = ''' + DateToStr(Date) + ''' and USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
test.Open;
if test.RecordCount = 0 then
begin
ADOTable1TAG.AsDateTime := Date;
ADOTable1KOMMEN.AsString := TimeToStr(Time);
ADOTable1FREIER_TAG.AsBoolean := (DayOfWeek(Date) = 1{Sunday}) or
(DayOfWeek(Date) = 7{Saturday});
end;
finally
test.Free;
end;
wwDBGrid1.SelectedField := ADOTable1TAG;
end;
procedure TForm1.ADOTable1PAUSE_ENDEGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1PAUSE_ENDESetText(Sender: TField; const Text: string);
begin
if Text = '' then
begin
ADOTable1PAUSE_ENDE.Clear;
end
else
begin
ADOTable1PAUSE_ENDE.AsString := Text;
end;
end;
procedure TForm1.ADOTable1PAUSE_STARTGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1PAUSE_STARTSetText(Sender: TField;
const Text: string);
begin
if Text = '' then
begin
ADOTable1PAUSE_START.Clear;
end
else
begin
ADOTable1PAUSE_START.AsString := Text;
end;
end;
procedure TForm1.ADOTable1SONSTIGER_ABZUGGetText(Sender: TField;
var Text: string; DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1SONSTIGER_ABZUGSetText(Sender: TField;
const Text: string);
begin
if Text = '' then
begin
ADOTable1SONSTIGER_ABZUG.Clear;
end
else
begin
ADOTable1SONSTIGER_ABZUG.AsString := Text;
end;
end;
procedure TForm1.ADOTable1TAGChange(Sender: TField);
begin
ADOTable1FREIER_TAG.AsBoolean := (DayOfWeek(ADOTable1TAG.AsDateTime) = 1{Sunday}) or
(DayOfWeek(ADOTable1TAG.AsDateTime) = 7{Saturday});
// TODO: "Wochentag" Feld aktualisieren
end;
procedure TForm1.ADOTable1TAGGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
if IstLeer(Sender) then
Text := Sender.AsString
else
Text := DateToStr(EchtesDatum(Sender));
end;
procedure TForm1.ADOTable1TAGSetText(Sender: TField; const Text: string);
var
i, punktCount: integer;
begin
punktCount := 0;
for i := 1 to Length(Text) do
begin
if Text[i] = '.' then inc(punktCount);
end;
if punktCount = 1 then
begin
ADOTable1TAG.AsString := Text + '.' + IntToStr(CurrentYear);
end
else if (PunktCount = 2) and EndsStr('.',Text) then
begin
ADOTable1TAG.AsString := Text + IntToStr(CurrentYear);
end
else
begin
ADOTable1TAG.AsString := Text;
end;
end;
procedure TForm1.ADOTable1WOCHENTAGGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
try
if ADOTable1TAG.AsString <> '' then
Text := ShortDayNames[DayOfWeek(EchtesDatum(ADOTable1TAG))]
else
Text := '';
except
Text := '??';
end;
end;
procedure TForm1.ADOTable1ZUHAUSEGetText(Sender: TField; var Text: string;
DisplayText: Boolean);
begin
Text := Copy(Sender.AsString, 1, 5);
end;
procedure TForm1.ADOTable1ZUHAUSESetText(Sender: TField; const Text: string);
begin
if Text = '' then
begin
ADOTable1ZUHAUSE.Clear;
end
else
begin
ADOTable1ZUHAUSE.AsString := Text;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ReorgAll;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
Label2.Caption := MinutenZuHF_Int(RegelArbeitszeit) + ' Std.';
ADOTable1.DisableControls;
ADOTable1.Active := false;
ADOTable1.ReadOnly := false;
ADOTable1.Filter := 'USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
ADOTable1.Filtered := true;
ADOTable1.Active := true;
ReorgAll;
ADOTable1.Active := false;
ADOTable1.ReadOnly := ComboBox1.Text <> WUserName;
ADOTable1.Active := true;
ADOTable1.Last;
Button1.Enabled := not ADOTable1.ReadOnly;
ADOTable1.EnableControls;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ADOTable1.State in [dsEdit, dsInsert] then
begin
try
ADOTable1.Post;
except
on E: EAbort do
begin
exit;
end;
end;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
test: TADOQuery;
ini: TMemIniFile;
resourcestring
DefaultConnectionString = 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Zeiterfassung;' +
'Data Source=SHS\FiVe,49007;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=MARSCHALL;Use Encryption for Data=False;Tag with column collation when possible=False;';
begin
ini := TMemIniFile.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini'));
try
ADOConnection1.ConnectionString := ini.ReadString('Connection', 'ConnectionString', DefaultConnectionString);
finally
ini.Free;
end;
ADOConnection1.Connected := true;
{$REGION 'Username Combobox füllen'}
test := TADOQuery.Create(nil);
try
test.Connection := ADOConnection1;
test.Close;
test.SQL.Text := 'select distinct USERNAME from TAGE';
test.Open;
ComboBox1.Items.Clear;
while not test.EOF do
begin
ComboBox1.Items.Add(test.FieldByName('USERNAME').AsString);
test.Next;
end;
finally
test.Free;
end;
if ComboBox1.Items.IndexOf(WUserName) = -1 then
ComboBox1.Items.Add(WUserName);
ComboBox1.Sorted := true;
ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(WUserName);
ComboBox1Change(ComboBox1);
{$ENDREGION}
if wwDBGrid1.CanFocus then wwDBGrid1.SetFocus;
wwDBGrid1.SelectedField := ADOTable1TAG;
end;
procedure TForm1.wwDBGrid1CalcCellColors(Sender: TObject; Field: TField;
State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush);
begin
if Highlight then exit;
if (Field.FieldName = ADOTable1WOCHENTAG.FieldName) or
(Field.FieldName = ADOTable1BERSTUNDEN.FieldName) or
(Field.FieldName = ADOTable1BERSTUNDEN_SALDO.FieldName) then
begin
ABrush.Color := clBtnFace;
end;
if (Field.FieldName = ADOTable1BERSTUNDEN.FieldName) then
begin
if ADOTable1BERSTUNDEN.AsInteger < 0 then
begin
AFont.Color := clRed;
end;
end;
if (Field.FieldName = ADOTable1BERSTUNDEN_SALDO.FieldName) then
begin
if ADOTable1BERSTUNDEN_SALDO.AsInteger < 0 then
begin
AFont.Color := clRed;
end;
end;
end;
end.