Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/delphiutils/trunk/Zeiterfassung/ZeiterfassungMain.pas
Revision: 83
Committed: Fri Mar 1 22:23:10 2019 UTC (3 years, 2 months ago) by daniel-marschall
Content type: text/x-pascal
File size: 17644 byte(s)

File Contents

# Content
1 unit ZeiterfassungMain;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, DB, ADODB, Grids, Wwdbigrd, Wwdbgrid, ExtCtrls, DBCtrls, StdCtrls;
8
9 type
10 TForm1 = class(TForm)
11 ADOConnection1: TADOConnection;
12 wwDBGrid1: TwwDBGrid;
13 ADOTable1: TADOTable;
14 DataSource1: TDataSource;
15 ADOTable1TAG: TWideStringField;
16 ADOTable1KOMMEN: TWideStringField;
17 ADOTable1PAUSE_START: TWideStringField;
18 ADOTable1PAUSE_ENDE: TWideStringField;
19 ADOTable1GEHEN: TWideStringField;
20 ADOTable1SONSTIGER_ABZUG: TWideStringField;
21 ADOTable1ZUHAUSE: TWideStringField;
22 ADOTable1BERSTUNDEN_SALDO: TIntegerField;
23 ADOTable1BERSTUNDEN: TIntegerField;
24 ADOTable1FREIER_TAG: TBooleanField;
25 Panel1: TPanel;
26 Button1: TButton;
27 DBNavigator1: TDBNavigator;
28 ADOTable1WOCHENTAG: TStringField;
29 ADOTable1USERNAME: TStringField;
30 ComboBox1: TComboBox;
31 Label1: TLabel;
32 Label2: TLabel;
33 ADOTable1BEMERKUNG: TStringField;
34 procedure ADOTable1NewRecord(DataSet: TDataSet);
35 procedure FormClose(Sender: TObject; var Action: TCloseAction);
36 procedure ADOTable1BeforePost(DataSet: TDataSet);
37 procedure ADOTable1BERSTUNDEN_SALDOGetText(Sender: TField; var Text: string;
38 DisplayText: Boolean);
39 procedure ADOTable1BERSTUNDENGetText(Sender: TField; var Text: string;
40 DisplayText: Boolean);
41 procedure wwDBGrid1CalcCellColors(Sender: TObject; Field: TField;
42 State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush);
43 procedure ADOTable1AfterPost(DataSet: TDataSet);
44 procedure Button1Click(Sender: TObject);
45 procedure ADOTable1TAGChange(Sender: TField);
46 procedure ADOTable1SONSTIGER_ABZUGSetText(Sender: TField;
47 const Text: string);
48 procedure ADOTable1ZUHAUSESetText(Sender: TField; const Text: string);
49 procedure ADOTable1GEHENSetText(Sender: TField; const Text: string);
50 procedure ADOTable1PAUSE_ENDESetText(Sender: TField; const Text: string);
51 procedure ADOTable1PAUSE_STARTSetText(Sender: TField; const Text: string);
52 procedure ADOTable1KOMMENSetText(Sender: TField; const Text: string);
53 procedure FormShow(Sender: TObject);
54 procedure ADOTable1WOCHENTAGGetText(Sender: TField; var Text: string;
55 DisplayText: Boolean);
56 procedure ComboBox1Change(Sender: TObject);
57 procedure ADOTable1TAGSetText(Sender: TField; const Text: string);
58 procedure ADOTable1AfterDelete(DataSet: TDataSet);
59 procedure ADOTable1TAGGetText(Sender: TField; var Text: string;
60 DisplayText: Boolean);
61 procedure ADOTable1KOMMENGetText(Sender: TField; var Text: string;
62 DisplayText: Boolean);
63 procedure ADOTable1PAUSE_STARTGetText(Sender: TField; var Text: string;
64 DisplayText: Boolean);
65 procedure ADOTable1PAUSE_ENDEGetText(Sender: TField; var Text: string;
66 DisplayText: Boolean);
67 procedure ADOTable1GEHENGetText(Sender: TField; var Text: string;
68 DisplayText: Boolean);
69 procedure ADOTable1SONSTIGER_ABZUGGetText(Sender: TField; var Text: string;
70 DisplayText: Boolean);
71 procedure ADOTable1ZUHAUSEGetText(Sender: TField; var Text: string;
72 DisplayText: Boolean);
73 procedure ADOTable1BeforeScroll(DataSet: TDataSet);
74 private
75 function GueltigeZeile: boolean;
76 protected
77 procedure ReorgDataSet;
78 procedure ReorgAll;
79 function RegelArbeitszeit: integer;
80 end;
81
82 var
83 Form1: TForm1;
84
85 implementation
86
87 {$R *.dfm}
88
89 // TODO: Trennstriche zwischen Wochen oder zwischen Urlauben
90 // IDEE: Wochenend-Multiplikator
91 // TODO: "Gehen um" Anzeige
92
93 uses
94 DateUtils, StrUtils, IniFiles;
95
96 {$REGION 'Hilfsfunktionen'}
97
98 function SQL_Escape(const s: string): string;
99 begin
100 result := StringReplace(s, '''', '\''', [rfReplaceAll]);
101 end;
102
103 function IstLeer(f: TField): boolean;
104 begin
105 result := f.IsNull or (f.AsString = '') or (f.AsString = '00:00:00');
106 end;
107
108 function Minuten(f: TField): integer;
109 begin
110 if IstLeer(f) then
111 begin
112 result := 0;
113 end
114 else
115 begin
116 result := MinuteOfTheDay(f.AsDateTime);
117 end;
118 end;
119
120 function MinutenZuHF_Int(min: integer): string;
121 var
122 d: integer;
123 begin
124 d := min;
125 if d < 0 then
126 begin
127 result := '-';
128 d := -d;
129 end
130 else
131 begin
132 result := '';
133 end;
134 result := result + Format('%.2d:%.2d', [d div 60, d mod 60]);
135 end;
136
137 function MinutenZuHF(f: TField): string;
138 begin
139 if IstLeer(f) then
140 begin
141 result := '';
142 end
143 else
144 begin
145 result := MinutenZuHF_Int(f.AsInteger);
146 end;
147 end;
148
149 function EchtesDatum(f: TField): TDate;
150 begin
151 if Copy(f.AsString, 5, 1) = '-' then
152 begin
153 result := EncodeDate(
154 StrtoInt(Copy(f.AsString, 1, 4)),
155 StrtoInt(Copy(f.AsString, 6, 2)),
156 StrtoInt(Copy(f.AsString, 9, 2))
157 );
158 end
159 else
160 result := StrToDate(f.AsString);
161 end;
162
163 function WUserName: String;
164 var
165 nSize: DWord;
166 begin
167 nSize := 1024;
168 SetLength(Result, nSize);
169 if GetUserName(PChar(Result), nSize) then
170 SetLength(Result, nSize-1)
171 else
172 RaiseLastOSError;
173 end;
174
175 {$ENDREGION}
176
177 function TForm1.RegelArbeitszeit: integer;
178 var
179 test: TADOQuery;
180 begin
181 test := TADOQuery.Create(nil);
182 try
183 test.Connection := ADOConnection1;
184 test.Close;
185 test.SQL.Text := 'select MINUTEN from REGELARBEITSZEIT where USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
186 test.Open;
187 if test.RecordCount = 0 then
188 begin
189 result := 8 * 60;
190 end
191 else
192 begin
193 result := test.FieldByName('MINUTEN').AsInteger;
194 end;
195 finally
196 test.Free;
197 end;
198 end;
199
200 procedure TForm1.ReorgAll;
201 var
202 saldo: integer;
203 baks: string;
204 bakEv: TDataSetNotifyEvent;
205 dead: boolean;
206 begin
207 if ADOTable1TAG.IsNull then
208 begin
209 baks := '';
210 end
211 else
212 begin
213 if Copy(ADOTable1TAG.AsString, 5, 1) = '-' then
214 baks := ADOTable1TAG.AsString
215 else
216 DateTimeToString(baks, 'YYYY-MM-DD', ADOTable1TAG.AsDateTime);
217 end;
218 ADOTable1.Requery();
219
220 bakEv := ADOTable1.AfterPost;
221 ADOTable1.AfterPost := nil;
222 ADOTable1.DisableControls;
223 try
224 ADOTable1.First;
225 saldo := 0;
226 dead := false;
227 while not ADOTable1.Eof do
228 begin
229 ADOTable1.Edit;
230 if not dead then ReorgDataSet;
231 dead := dead or ADOTable1BERSTUNDEN.IsNull;
232 if dead then
233 begin
234 ADOTable1BERSTUNDEN_SALDO.Clear;
235 end
236 else
237 begin
238 saldo := saldo + ADOTable1BERSTUNDEN.AsInteger;
239 ADOTable1BERSTUNDEN_SALDO.AsInteger := saldo;
240 saldo := ADOTable1BERSTUNDEN_SALDO.AsInteger;
241 end;
242 ADOTable1.Post;
243 ADOTable1.Next;
244 end;
245 finally
246 if baks <> '' then ADOTable1.Locate('USERNAME;TAG', VarArrayOf([WUserName, baks]), []);
247 ADOTable1.AfterPost := bakEv;
248 ADOTable1.EnableControls;
249 end;
250 end;
251
252 procedure TForm1.ADOTable1AfterDelete(DataSet: TDataSet);
253 begin
254 ReorgAll;
255 end;
256
257 procedure TForm1.ADOTable1AfterPost(DataSet: TDataSet);
258 begin
259 ReorgAll;
260 end;
261
262 function TForm1.GueltigeZeile: boolean;
263 begin
264 result := false;
265
266 if IstLeer(ADOTable1KOMMEN) <> IstLeer(ADOTable1GEHEN) then exit;
267 if IstLeer(ADOTable1PAUSE_START) <> IstLeer(ADOTable1PAUSE_ENDE) then exit;
268 if not IstLeer(ADOTable1PAUSE_START) and (ADOTable1PAUSE_START.AsDateTime < ADOTable1KOMMEN.AsDateTime) then exit;
269 if not IstLeer(ADOTable1PAUSE_ENDE) and (ADOTable1PAUSE_ENDE.AsDateTime < ADOTable1PAUSE_START.AsDateTime) then exit;
270 if not IstLeer(ADOTable1GEHEN) and (ADOTable1GEHEN.AsDateTime < ADOTable1KOMMEN.AsDateTime) then exit;
271 if not IstLeer(ADOTable1GEHEN) and not IstLeer(ADOTable1PAUSE_START) and (ADOTable1GEHEN.AsDateTime < ADOTable1PAUSE_START.AsDateTime) then exit;
272 if not IstLeer(ADOTable1GEHEN) and not IstLeer(ADOTable1PAUSE_ENDE) and (ADOTable1GEHEN.AsDateTime < ADOTable1PAUSE_ENDE.AsDateTime) then exit;
273
274 result := true;
275 end;
276
277 procedure TForm1.ReorgDataSet;
278 var
279 m: integer;
280 begin
281 if GueltigeZeile then
282 begin
283 m := (Minuten(ADOTable1GEHEN) - Minuten(ADOTable1KOMMEN))
284 - (Minuten(ADOTable1PAUSE_ENDE) - Minuten(ADOTable1PAUSE_START))
285 - Minuten(ADOTable1SONSTIGER_ABZUG)
286 + Minuten(ADOTable1ZUHAUSE);
287
288 if not ADOTable1FREIER_TAG.AsBoolean then
289 begin
290 m := m - RegelArbeitszeit;
291 end;
292
293 ADOTable1BERSTUNDEN.AsInteger := m;
294 end
295 else
296 begin
297 ADOTable1BERSTUNDEN.Clear;
298 end;
299 end;
300
301 procedure TForm1.ADOTable1BeforePost(DataSet: TDataSet);
302 begin
303 if (ADOTable1.State = dsInsert) and ADOTable1TAG.IsNull then
304 begin
305 AdoTable1.Cancel;
306 Abort;
307 end;
308
309 ReorgDataSet;
310 end;
311
312 procedure TForm1.ADOTable1BeforeScroll(DataSet: TDataSet);
313 begin
314 if (DataSet.State = dsInsert) and (not ADOTable1TAG.IsNull) then Dataset.Post;
315 end;
316
317 procedure TForm1.ADOTable1BERSTUNDENGetText(Sender: TField; var Text: string;
318 DisplayText: Boolean);
319 begin
320 Text := MinutenZuHF(ADOTable1BERSTUNDEN);
321 end;
322
323 procedure TForm1.ADOTable1BERSTUNDEN_SALDOGetText(Sender: TField;
324 var Text: string; DisplayText: Boolean);
325 begin
326 Text := MinutenZuHF(ADOTable1BERSTUNDEN_SALDO);
327 end;
328
329 procedure TForm1.ADOTable1GEHENGetText(Sender: TField; var Text: string;
330 DisplayText: Boolean);
331 begin
332 Text := Copy(Sender.AsString, 1, 5);
333 end;
334
335 procedure TForm1.ADOTable1GEHENSetText(Sender: TField; const Text: string);
336 begin
337 if Text = '' then
338 begin
339 ADOTable1GEHEN.Clear;
340 end
341 else
342 begin
343 if Pos(':', Text) = 0 then
344 ADOTable1GEHEN.AsString := Text + ':00'
345 else
346 ADOTable1GEHEN.AsString := Text;
347 end;
348 end;
349
350 procedure TForm1.ADOTable1KOMMENGetText(Sender: TField; var Text: string;
351 DisplayText: Boolean);
352 begin
353 Text := Copy(Sender.AsString, 1, 5);
354 end;
355
356 procedure TForm1.ADOTable1KOMMENSetText(Sender: TField; const Text: string);
357 begin
358 if Text = '' then
359 begin
360 ADOTable1KOMMEN.Clear;
361 end
362 else
363 begin
364 if Pos(':', Text) = 0 then
365 ADOTable1KOMMEN.AsString := Text + ':00'
366 else
367 ADOTable1KOMMEN.AsString := Text;
368 end;
369 end;
370
371 procedure TForm1.ADOTable1NewRecord(DataSet: TDataSet);
372 var
373 test: TADOQuery;
374 begin
375 ADOTable1FREIER_TAG.AsBoolean := false;
376 ADOTable1USERNAME.AsString := WUserName;
377 test := TADOQuery.Create(nil);
378 try
379 test.Connection := ADOConnection1;
380 test.Close;
381 test.SQL.Text := 'select * from TAGE where TAG = ''' + DateToStr(Date) + ''' and USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
382 test.Open;
383 if test.RecordCount = 0 then
384 begin
385
386 ADOTable1TAG.AsDateTime := Date;
387 ADOTable1KOMMEN.AsString := TimeToStr(Time);
388 ADOTable1FREIER_TAG.AsBoolean := (DayOfWeek(Date) = 1{Sunday}) or
389 (DayOfWeek(Date) = 7{Saturday});
390 end;
391 finally
392 test.Free;
393 end;
394
395 wwDBGrid1.SelectedField := ADOTable1TAG;
396 end;
397
398 procedure TForm1.ADOTable1PAUSE_ENDEGetText(Sender: TField; var Text: string;
399 DisplayText: Boolean);
400 begin
401 Text := Copy(Sender.AsString, 1, 5);
402 end;
403
404 procedure TForm1.ADOTable1PAUSE_ENDESetText(Sender: TField; const Text: string);
405 begin
406 if Text = '' then
407 begin
408 ADOTable1PAUSE_ENDE.Clear;
409 end
410 else
411 begin
412 if Pos(':', Text) = 0 then
413 ADOTable1PAUSE_ENDE.AsString := Text + ':00'
414 else
415 ADOTable1PAUSE_ENDE.AsString := Text;
416 end;
417 end;
418
419 procedure TForm1.ADOTable1PAUSE_STARTGetText(Sender: TField; var Text: string;
420 DisplayText: Boolean);
421 begin
422 Text := Copy(Sender.AsString, 1, 5);
423 end;
424
425 procedure TForm1.ADOTable1PAUSE_STARTSetText(Sender: TField;
426 const Text: string);
427 begin
428 if Text = '' then
429 begin
430 ADOTable1PAUSE_START.Clear;
431 end
432 else
433 begin
434 if Pos(':', Text) = 0 then
435 ADOTable1PAUSE_START.AsString := Text + ':00'
436 else
437 ADOTable1PAUSE_START.AsString := Text;
438 end;
439 end;
440
441 procedure TForm1.ADOTable1SONSTIGER_ABZUGGetText(Sender: TField;
442 var Text: string; DisplayText: Boolean);
443 begin
444 Text := Copy(Sender.AsString, 1, 5);
445 end;
446
447 procedure TForm1.ADOTable1SONSTIGER_ABZUGSetText(Sender: TField;
448 const Text: string);
449 begin
450 if Text = '' then
451 begin
452 ADOTable1SONSTIGER_ABZUG.Clear;
453 end
454 else
455 begin
456 if Pos(':', Text) = 0 then
457 ADOTable1SONSTIGER_ABZUG.AsString := Text + ':00'
458 else
459 ADOTable1SONSTIGER_ABZUG.AsString := Text;
460 end;
461 end;
462
463 procedure TForm1.ADOTable1TAGChange(Sender: TField);
464 begin
465 ADOTable1FREIER_TAG.AsBoolean := (DayOfWeek(ADOTable1TAG.AsDateTime) = 1{Sunday}) or
466 (DayOfWeek(ADOTable1TAG.AsDateTime) = 7{Saturday});
467 // TODO: "Wochentag" Feld aktualisieren
468 end;
469
470 procedure TForm1.ADOTable1TAGGetText(Sender: TField; var Text: string;
471 DisplayText: Boolean);
472 begin
473 if IstLeer(Sender) then
474 Text := Sender.AsString
475 else
476 Text := DateToStr(EchtesDatum(Sender));
477 end;
478
479 procedure TForm1.ADOTable1TAGSetText(Sender: TField; const Text: string);
480 var
481 i, punktCount: integer;
482 begin
483 punktCount := 0;
484 for i := 1 to Length(Text) do
485 begin
486 if Text[i] = '.' then inc(punktCount);
487 end;
488
489 if punktCount = 1 then
490 begin
491 ADOTable1TAG.AsString := Text + '.' + IntToStr(CurrentYear);
492 end
493 else if (PunktCount = 2) and EndsStr('.',Text) then
494 begin
495 ADOTable1TAG.AsString := Text + IntToStr(CurrentYear);
496 end
497 else
498 begin
499 ADOTable1TAG.AsString := Text;
500 end;
501 end;
502
503 procedure TForm1.ADOTable1WOCHENTAGGetText(Sender: TField; var Text: string;
504 DisplayText: Boolean);
505 begin
506 try
507 if ADOTable1TAG.AsString <> '' then
508 Text := ShortDayNames[DayOfWeek(EchtesDatum(ADOTable1TAG))]
509 else
510 Text := '';
511 except
512 Text := '??';
513 end;
514 end;
515
516 procedure TForm1.ADOTable1ZUHAUSEGetText(Sender: TField; var Text: string;
517 DisplayText: Boolean);
518 begin
519 Text := Copy(Sender.AsString, 1, 5);
520 end;
521
522 procedure TForm1.ADOTable1ZUHAUSESetText(Sender: TField; const Text: string);
523 begin
524 if Text = '' then
525 begin
526 ADOTable1ZUHAUSE.Clear;
527 end
528 else
529 begin
530 if Pos(':', Text) = 0 then
531 ADOTable1ZUHAUSE.AsString := Text + ':00'
532 else
533 ADOTable1ZUHAUSE.AsString := Text;
534 end;
535 end;
536
537 procedure TForm1.Button1Click(Sender: TObject);
538 begin
539 ReorgAll;
540 end;
541
542 procedure TForm1.ComboBox1Change(Sender: TObject);
543 begin
544 Label2.Caption := MinutenZuHF_Int(RegelArbeitszeit) + ' Std.';
545
546 ADOTable1.DisableControls;
547
548 ADOTable1.Active := false;
549 ADOTable1.ReadOnly := false;
550 ADOTable1.Filter := 'USERNAME = ''' + SQL_Escape(ComboBox1.Text) + '''';
551 ADOTable1.Filtered := true;
552 ADOTable1.Active := true;
553
554 ReorgAll;
555
556 ADOTable1.Active := false;
557 ADOTable1.ReadOnly := ComboBox1.Text <> WUserName;
558 ADOTable1.Active := true;
559
560 ADOTable1.Last;
561 Button1.Enabled := not ADOTable1.ReadOnly;
562
563 ADOTable1.EnableControls;
564 end;
565
566 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
567 begin
568 if ADOTable1.State in [dsEdit, dsInsert] then
569 begin
570 try
571 ADOTable1.Post;
572 except
573 on E: EAbort do
574 begin
575 exit;
576 end;
577 end;
578 end;
579 end;
580
581 procedure TForm1.FormShow(Sender: TObject);
582 var
583 test: TADOQuery;
584 ini: TMemIniFile;
585 resourcestring
586 DefaultConnectionString = 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Zeiterfassung;' +
587 '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;';
588 begin
589 ini := TMemIniFile.Create(IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + ChangeFileExt(ExtractFileName(ParamStr(0)), '.ini'));
590 try
591 ADOConnection1.ConnectionString := ini.ReadString('Connection', 'ConnectionString', DefaultConnectionString);
592 finally
593 ini.Free;
594 end;
595 ADOConnection1.Connected := true;
596
597 {$REGION 'Username Combobox füllen'}
598 test := TADOQuery.Create(nil);
599 try
600 test.Connection := ADOConnection1;
601 test.Close;
602 test.SQL.Text := 'select distinct USERNAME from TAGE';
603 test.Open;
604 ComboBox1.Items.Clear;
605 while not test.EOF do
606 begin
607 ComboBox1.Items.Add(test.FieldByName('USERNAME').AsString);
608 test.Next;
609 end;
610 finally
611 test.Free;
612 end;
613
614 if ComboBox1.Items.IndexOf(WUserName) = -1 then
615 ComboBox1.Items.Add(WUserName);
616
617 ComboBox1.Sorted := true;
618
619 ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(WUserName);
620
621 ComboBox1Change(ComboBox1);
622 {$ENDREGION}
623
624 if wwDBGrid1.CanFocus then wwDBGrid1.SetFocus;
625 wwDBGrid1.SelectedField := ADOTable1TAG;
626 end;
627
628 procedure TForm1.wwDBGrid1CalcCellColors(Sender: TObject; Field: TField;
629 State: TGridDrawState; Highlight: Boolean; AFont: TFont; ABrush: TBrush);
630 begin
631 if Highlight then exit;
632
633 if (Field.FieldName = ADOTable1WOCHENTAG.FieldName) or
634 (Field.FieldName = ADOTable1BERSTUNDEN.FieldName) or
635 (Field.FieldName = ADOTable1BERSTUNDEN_SALDO.FieldName) then
636 begin
637 ABrush.Color := clBtnFace;
638 end;
639
640 if (Field.FieldName = ADOTable1BERSTUNDEN.FieldName) then
641 begin
642 if ADOTable1BERSTUNDEN.AsInteger < 0 then
643 begin
644 AFont.Color := clRed;
645 end;
646 end;
647
648 if (Field.FieldName = ADOTable1BERSTUNDEN_SALDO.FieldName) then
649 begin
650 if ADOTable1BERSTUNDEN_SALDO.AsInteger < 0 then
651 begin
652 AFont.Color := clRed;
653 end;
654 end;
655 end;
656
657 end.