Check-in [0231250648]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added global hotkey, timestamp of insert row gets updated a lot more often
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0231250648808d49192ec4f25f5a714e658de87f
User & Date: Martijn 2011-05-08 17:35:13
Context
2011-05-08
18:42
Moved current files under Entry; merged SnapShooter and SnapViewer projects into source tree check-in: fc0aa399a1 user: Martijn tags: trunk
17:35
Added global hotkey, timestamp of insert row gets updated a lot more often check-in: 0231250648 user: Martijn tags: trunk
2011-05-05
12:21
Added week numbers to the date picker; also, dates that have some info are shown in bold (doesn't work after switching months, though) check-in: 17cbddfd91 user: MCO tags: trunk
Changes

Changes to src/F_Entry.dfm.

33
34
35
36
37
38
39

40
41
42
43
44
45
46
    Format = 'd MMMM yyyy'
    Time = 40667.351732187500000000
    DoubleBuffered = True
    ParentDoubleBuffered = False
    TabOrder = 1
    OnChange = dtpDayChange
    OnDropDown = dtpDayDropDown

  end
  object Grid: TStringGrid
    Left = 8
    Top = 35
    Width = 534
    Height = 375
    Anchors = [akLeft, akTop, akRight, akBottom]







>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
    Format = 'd MMMM yyyy'
    Time = 40667.351732187500000000
    DoubleBuffered = True
    ParentDoubleBuffered = False
    TabOrder = 1
    OnChange = dtpDayChange
    OnDropDown = dtpDayDropDown
    OnKeyDown = dtpDayKeyDown
  end
  object Grid: TStringGrid
    Left = 8
    Top = 35
    Width = 534
    Height = 375
    Anchors = [akLeft, akTop, akRight, akBottom]

Changes to src/F_Entry.pas.

16
17
18
19
20
21
22

23
24
25
26
27
28
29
..
30
31
32
33
34
35
36
37
38
39
40
41




42
43
44
45
46
47
48
..
62
63
64
65
66
67
68

69
70
71
72



73
74
75
76
77
78
79
...
102
103
104
105
106
107
108

109
110
111
112
113
114
115
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
...
203
204
205
206
207
208
209










210
211
212
213
214
215
216
217
218
219
220
221






















222
223
224
225
226
227
228
...
276
277
278
279
280
281
282



283
284
285
286
287
288
289
...
451
452
453
454
455
456
457
458




















459
    procedure FormCreate(Sender: TObject);
    procedure tbsWeekChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
    procedure dtpDayChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure dtpDayDropDown(Sender: TObject);

  private
    { Private declarations }
    FDoneLoading: Boolean;
    FInhibitEvents: boolean;
    FDB: TSQLiteDatabase;
    FActiveDate: TDateTime;
    FLoadQuery: TSQLiteQuery;
................................................................................
    FClearQuery: TSQLiteQuery;
    FSaveQuery: TSQLiteQuery;

    procedure FillHeaders;
    function  SQLDateToStr(Date: TDateTime): string;
    function  SQLDateTimeToStr(Date: TDateTime): string;
    procedure SetDate(NewDate: TDateTime);
    function  AddRow(CurrentDate: TDateTime): Integer;
    procedure SaveGrid(Date: TDateTime);
    procedure LoadGrid(Date: TDateTime);
    procedure InitializeDB;
    procedure ClearGrid;




  public
    { Public declarations }
  end;

var
  frmEntry: TfrmEntry;

................................................................................
  MCS_SHORTDAYSOFWEEK = $0080;
  MCS_NOSELCHANGEONNAV = $0100;
var
  style{, prevstyle}: LResult;
var
  Row: Integer;
begin

  style := SendMessage(dtpDay.Handle, DTM_GETMCSTYLE, 0, 0);
  style := style or MCS_DAYSTATE or MCS_WEEKNUMBERS or MCS_NOSELCHANGEONNAV;
  {prevstyle := }SendMessage(dtpDay.Handle, DTM_SETMCSTYLE, 0, style);




  try
    dtpDay.MaxDate := dtpDay.Date + 7; // eigenlijk niet verder dan a.s. zondag...
    FillHeaders;
    InitializeDB;

    SetDate(Date);
    Row := AddRow(FActiveDate);
................................................................................
    end;
  end;
end{TfrmEntry.FormCloseQuery};
{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FDB);

end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FormResize(Sender: TObject);
begin
  // TODO: autosize column 2
end;
................................................................................
procedure TfrmEntry.GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  KeyShift: TShiftState;
begin
  KeyShift := Shift * [ssShift, ssCtrl, ssAlt];
  case Key of
    VK_TAB: begin
      if (KeyShift = []) and (goEditing in Grid.Options)
          and (Grid.Col = Grid.ColCount - 1) and (Grid.Row = Grid.RowCount - 1) then begin
        AddRow(FActiveDate);
      end else if ssCtrl in KeyShift then begin
        if ssShift in KeyShift then begin
          SetDate(FActiveDate - 1);
        end else begin
          if FActiveDate + 2 < dtpDay.MaxDate then
            SetDate(FActiveDate + 1);
        end{if};
      end{if};
    end;
    VK_F4: begin
      if KeyShift = [] then begin
        dtpDay.SetFocus;
        PostMessage(dtpDay.Handle, WM_KEYDOWN, VK_F4, 0);
        PostMessage(dtpDay.Handle, WM_KEYUP, VK_F4, 0);
      end;
................................................................................
      end;
    finally
      Cursor.Free;
    end;
  end{for};
  SendMessage(monthCalHandle, MCM_SETDAYSTATE, Length(boldDates), integer(@boldDates[0]));
end;











{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.tbsWeekChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
begin
  AllowChange := True;
  if not FInhibitEvents then begin
    if AllowChange then begin
      SetDate(dtpDay.Date + (NewTab - tbsWeek.TabIndex));
    end;
  end;
end{TfrmEntry.tbsWeekChange};
























{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FillHeaders;
begin
  Grid.Cells[0, 0] := 'Tijd';
  Grid.Cells[1, 0] := 'Project';
  Grid.Cells[2, 0] := 'Werkzaamheden';
................................................................................
end;

{ ------------------------------------------------------------------------------------------------ }
function TfrmEntry.AddRow(CurrentDate: TDateTime): Integer;
var
  LastRow, Col: Integer;
begin



  LastRow := Grid.RowCount - 1;
  for Col := 1 to Grid.ColCount - 1 do begin
    if Trim(Grid.Cells[Col, LastRow]) <> '' then begin
      Inc(LastRow);
      Break;
    end;
  end;
................................................................................
  Row := Grid.FixedRows;
  Grid.Objects[0, Row] := nil;
  for Col := 0 to Grid.ColCount - 1 do begin
    Grid.Cells[Col, Row] := '';
  end;
  Grid.EditorMode := OldEditorMode;
end{TfrmEntry.ClearGrid};





















end.







>







 







|




>
>
>
>







 







>




>
>
>







 







>







 







|
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>
>
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
..
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
...
128
129
130
131
132
133
134
135










136
137
138
139
140
141
142
...
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
...
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
    procedure FormCreate(Sender: TObject);
    procedure tbsWeekChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
    procedure dtpDayChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure dtpDayDropDown(Sender: TObject);
    procedure dtpDayKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    { Private declarations }
    FDoneLoading: Boolean;
    FInhibitEvents: boolean;
    FDB: TSQLiteDatabase;
    FActiveDate: TDateTime;
    FLoadQuery: TSQLiteQuery;
................................................................................
    FClearQuery: TSQLiteQuery;
    FSaveQuery: TSQLiteQuery;

    procedure FillHeaders;
    function  SQLDateToStr(Date: TDateTime): string;
    function  SQLDateTimeToStr(Date: TDateTime): string;
    procedure SetDate(NewDate: TDateTime);
    function  AddRow(CurrentDate: TDateTime = -1): Integer;
    procedure SaveGrid(Date: TDateTime);
    procedure LoadGrid(Date: TDateTime);
    procedure InitializeDB;
    procedure ClearGrid;
    procedure HandleCtrlTab(Shift: TShiftState);

    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
    procedure WMHotkey(var msg: TWMHotkey);         message WM_HOTKEY;
  public
    { Public declarations }
  end;

var
  frmEntry: TfrmEntry;

................................................................................
  MCS_SHORTDAYSOFWEEK = $0080;
  MCS_NOSELCHANGEONNAV = $0100;
var
  style{, prevstyle}: LResult;
var
  Row: Integer;
begin
  // TODO: create subclass of TDateTimePicker that handles this (and the MCM_DAYSTATE mess)
  style := SendMessage(dtpDay.Handle, DTM_GETMCSTYLE, 0, 0);
  style := style or MCS_DAYSTATE or MCS_WEEKNUMBERS or MCS_NOSELCHANGEONNAV;
  {prevstyle := }SendMessage(dtpDay.Handle, DTM_SETMCSTYLE, 0, style);

  // TODO: get hotkey combo from settings
  RegisterHotKey(Self.Handle, 1, MOD_CONTROL or MOD_WIN, Ord('U'));

  try
    dtpDay.MaxDate := dtpDay.Date + 7; // eigenlijk niet verder dan a.s. zondag...
    FillHeaders;
    InitializeDB;

    SetDate(Date);
    Row := AddRow(FActiveDate);
................................................................................
    end;
  end;
end{TfrmEntry.FormCloseQuery};
{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FDB);
  UnRegisterHotKey(Self.Handle, 1);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FormResize(Sender: TObject);
begin
  // TODO: autosize column 2
end;
................................................................................
procedure TfrmEntry.GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  KeyShift: TShiftState;
begin
  KeyShift := Shift * [ssShift, ssCtrl, ssAlt];
  case Key of
    VK_TAB: begin
      HandleCtrlTab(Shift);










    end;
    VK_F4: begin
      if KeyShift = [] then begin
        dtpDay.SetFocus;
        PostMessage(dtpDay.Handle, WM_KEYDOWN, VK_F4, 0);
        PostMessage(dtpDay.Handle, WM_KEYUP, VK_F4, 0);
      end;
................................................................................
      end;
    finally
      Cursor.Free;
    end;
  end{for};
  SendMessage(monthCalHandle, MCM_SETDAYSTATE, Length(boldDates), integer(@boldDates[0]));
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.dtpDayKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_TAB: begin
      HandleCtrlTab(Shift);
    end;
  end;
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.tbsWeekChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
begin
  AllowChange := True;
  if not FInhibitEvents then begin
    if AllowChange then begin
      SetDate(dtpDay.Date + (NewTab - tbsWeek.TabIndex));
    end;
  end;
end{TfrmEntry.tbsWeekChange};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.WMActivate(var Message: TWMActivate);
begin
  AddRow(FActiveDate);
end;

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.WMHotkey(var msg: TWMHotkey);
begin
  case Msg.HotKey of
    1: begin // Toggle visibility
      if Visible then begin
        Self.Hide;
        SaveGrid(FActiveDate);
      end else begin
        Self.Show;
        SetForegroundWindow(Self.Handle);
        AddRow;
      end;
    end;
  end;
end{TfrmEntry.WMHotkey};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.FillHeaders;
begin
  Grid.Cells[0, 0] := 'Tijd';
  Grid.Cells[1, 0] := 'Project';
  Grid.Cells[2, 0] := 'Werkzaamheden';
................................................................................
end;

{ ------------------------------------------------------------------------------------------------ }
function TfrmEntry.AddRow(CurrentDate: TDateTime): Integer;
var
  LastRow, Col: Integer;
begin
  if CurrentDate = -1 then
    CurrentDate := FActiveDate;

  LastRow := Grid.RowCount - 1;
  for Col := 1 to Grid.ColCount - 1 do begin
    if Trim(Grid.Cells[Col, LastRow]) <> '' then begin
      Inc(LastRow);
      Break;
    end;
  end;
................................................................................
  Row := Grid.FixedRows;
  Grid.Objects[0, Row] := nil;
  for Col := 0 to Grid.ColCount - 1 do begin
    Grid.Cells[Col, Row] := '';
  end;
  Grid.EditorMode := OldEditorMode;
end{TfrmEntry.ClearGrid};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmEntry.HandleCtrlTab(Shift: TShiftState);
var
  KeyShift: TShiftState;
begin
  KeyShift := Shift * [ssShift, ssCtrl, ssAlt];
  if (KeyShift = []) and (goEditing in Grid.Options)
      and (Grid.Col = Grid.ColCount - 1) and (Grid.Row = Grid.RowCount - 1) then
  begin
    AddRow(FActiveDate);
  end else if ssCtrl in KeyShift then begin
    if ssShift in KeyShift then begin
      SetDate(FActiveDate - 1);
    end else begin
      if FActiveDate + 2 < dtpDay.MaxDate then
        SetDate(FActiveDate + 1);
    end{if};
  end{if};
end{TfrmEntry.HandleCtrlTab};

end.

Changes to src/lib/SQLite3Database.pas.

113
114
115
116
117
118
119








120
121
122
123
124
125
126
procedure DisposeProc(Ptr: pointer); cdecl;

////////////////////////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils, Windows;









{ ------------------------------------------------------------------------------------------------ }
procedure DisposeProc(Ptr: pointer); cdecl;
begin
  if Assigned(Ptr) then
    Freemem(Ptr);
end;







>
>
>
>
>
>
>
>







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
procedure DisposeProc(Ptr: pointer); cdecl;

////////////////////////////////////////////////////////////////////////////////////////////////////
implementation

uses
  SysUtils, Windows;

{$IFNDEF VER200} // before Delphi 2009
function SetDllDirectory(lpPathName:PChar): Bool; stdcall; external 'kernel32.dll' name 'SetDllDirectoryA';
{$ELSE}
  {$IFNDEF VER210} // before Delphi 2010 (which has this in the Windows unit)
function SetDllDirectory(lpPathName:PWideChar): Bool; stdcall; external 'kernel32.dll' name 'SetDllDirectoryW';
  {$ENDIF}
{$ENDIF}

{ ------------------------------------------------------------------------------------------------ }
procedure DisposeProc(Ptr: pointer); cdecl;
begin
  if Assigned(Ptr) then
    Freemem(Ptr);
end;