{------------------------------------------------------------------------------}
{
   Unit Name: askdate
   Purpose  : Form to input dates thru calendar.
   Author   : Vesa Lappalainen
   Date     : 06.06.1997
   Changed  :

   ToDo     :
}
{------------------------------------------------------------------------------}

unit askdate;

interface

uses
  SysUtils, Classes,
{$ifdef CLX}
  QGraphics, QControls, QForms, QDialogs, QComCtrls, QGrids, QStdCtrls, QExtCtrls,  QActnList,
{$else}
  Windows, Messages,
  Graphics, Controls, Forms, Dialogs, ComCtrls, Grids, StdCtrls, ExtCtrls,  ActnList,
  Calendar, Spin,
{$endif}
  savepos;

{$ifdef CLX}

{$else}
type
  TFormAskDate = class(TForm)
    Question: TPanel;
    LabelDate: TPanel;
    Panel1: TPanel;
    GridWeek: TStringGrid;
    Cal: TCalendar;
    Panel2: TPanel;
    SpinButtonDay: TSpinButton;
    SpinButtonMonth: TSpinButton;
    SpinButtonYear: TSpinButton;
    CBMonth: TComboBox;
    Panel3: TPanel;
    ButtonCancel: TButton;
    ButtonOK: TButton;
    SpinButtonWeek: TSpinButton;
    LabelWeekText: TLabel;
    LabelDayText: TLabel;
    LabelMonthText: TLabel;
    LabelYearText: TLabel;
    SavePos1: TSavePos;
    EditWeek: TEdit;
    EditDay: TEdit;
    EditMonth: TEdit;
    EditYear: TEdit;
    ActionList1: TActionList;
    ActionDot: TAction;
    ActionSlash: TAction;
    procedure SpinButtonDayDownClick(Sender: TObject);
    procedure SpinButtonDayUpClick(Sender: TObject);
    procedure SpinButtonMonthDownClick(Sender: TObject);
    procedure SpinButtonMonthUpClick(Sender: TObject);
    procedure SpinButtonYearDownClick(Sender: TObject);
    procedure SpinButtonYearUpClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DateTimeChange(Sender: TObject);
    procedure CalChange(Sender: TObject);
    procedure CBMonthChange(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpinButtonWeekDownClick(Sender: TObject);
    procedure SpinButtonWeekUpClick(Sender: TObject);
    procedure EditWeekChange(Sender: TObject);
    procedure EditDayChange(Sender: TObject);
    procedure EditMonthChange(Sender: TObject);
    procedure EditYearChange(Sender: TObject);
    procedure ActionDotExecute(Sender: TObject);
  private
    Edits : array[0..2] of TEdit;
    activeEdit : integer;
    procedure SyncCal;
    procedure SyncDate;
    procedure SyncOthers;
    function GetDay: integer;
    function GetMonth: integer;
    function GetWeek: integer;
    function GetYear: integer;
    procedure SetDay(const Value: integer);
    procedure SetMonth(const Value: integer);
    procedure SetWeek(const Value: integer);
    procedure SetYear(const Value: integer);
  public
    procedure ChangeDay(i:integer);
    procedure ChangeMonth(i:integer);
    procedure ChangeYear(i:integer);
    property Day:integer read GetDay write SetDay;
    property Month:integer read GetMonth write SetMonth;
    property Year:integer read GetYear write SetYear;
    property Week:integer read GetWeek write SetWeek;
  end;
{$endif}

function DoAskDate(q:string; var res : TDateTime; def : TDateTime) : boolean; overload;
function DoAskDate(q:string; var res : TDateTime) : boolean; overload;

//var
//  FormAskDate: TFormAskDate;

implementation
uses kdate;

function DoAskDate(q:string; var res : TDateTime) : boolean;
begin
  Result := DoAskDate(q,res,now);
end;

{$ifdef CLX}
function DoAskDate(q:string; var res : TDateTime; def : TDateTime) : boolean;
begin
  Result := false;
end;

{$else}
{$R *.dfm}

procedure TFormAskDate.SyncOthers;
var w,d,m,y:word;
begin
//  LabelMonth.Caption := FormatDateTime('mmmm, yyyy',Cal.CalendarDate);
  DecodeDate(Cal.CalendarDate,y,m,d);
  CBMonth.ItemIndex := m-1;
  w := weekno(d,m,y);
  LabelDate.Caption := FormatDateTime('c',Cal.CalendarDate);
  EditYear.Text := IntToStr(y);
  EditMonth.Text := FormatDateTime('m',Cal.CalendarDate);
  EditDay.Text := FormatDateTime('d',Cal.CalendarDate);
  EditWeek.Text := IntToStr(w);
end;

procedure TFormAskDate.SyncCal;
begin
//  Cal.CalendarDate := DateTime.Date;
  SyncOthers;
end;

procedure TFormAskDate.SyncDate;
var i,w:integer;
    d,m,y:word;
begin
  SyncOthers;
  DecodeDate(Cal.CalendarDate,y,m,d);
  w := weekno(1,m,y);
  for i:=1 to 6 do begin
    if ( i = 2 ) and ( w > 50 ) then w := 0;
    if ( i = 6 ) and ( w+i > 50 ) then
        w := weekno(1,1,y+1)-i+1;
    if ( i = 6 ) and ( Cal.CellText[0,6] = '' ) then
      GridWeek.Cells[0,i] := ''
    else
      GridWeek.Cells[0,i] := IntToStr(w+i-1);
  end;
  i := DayOfWeek(EncodeDate(Cal.Year,Cal.Month,1))-2;
  if ( i < 0 ) then i := 6;
  GridWeek.Row := ((Cal.Day -1 + i  )div 7)+1;
end;

procedure TFormAskDate.ChangeDay(i:integer);
begin
  Cal.CalendarDate := Cal.CalendarDate + i;
  SyncDate;
end;

procedure TFormAskDate.ChangeMonth(i:integer);
//var m:integer;
begin
//  if ( i < 0 ) then for m:=1 to -i do Cal.PrevMonth
//  else for m:=1 to i do Cal.NextMonth;
  Cal.CalendarDate := IncMonth(Cal.CalendarDate,i);
  SyncDate;
end;

procedure TFormAskDate.ChangeYear(i:integer);
var m:integer;
begin
  if ( i < 0 ) then for m:=1 to -i do Cal.PrevYear
  else for m:=1 to i do Cal.NextYear;
  SyncDate;
end;

procedure TFormAskDate.SpinButtonDayDownClick(Sender: TObject);
begin
  ChangeDay(+1);
end;

procedure TFormAskDate.SpinButtonDayUpClick(Sender: TObject);
begin
  ChangeDay(-1);
end;

procedure TFormAskDate.SpinButtonMonthDownClick(Sender: TObject);
begin
  ChangeMonth(+1);
end;

procedure TFormAskDate.SpinButtonMonthUpClick(Sender: TObject);
begin
  ChangeMonth(-1);
end;

procedure TFormAskDate.SpinButtonYearDownClick(Sender: TObject);
begin
  ChangeYear(+1);
end;

procedure TFormAskDate.SpinButtonYearUpClick(Sender: TObject);
begin
  ChangeYear(-1);
end;

procedure TFormAskDate.SpinButtonWeekDownClick(Sender: TObject);
begin
  ChangeDay(+7);
end;

procedure TFormAskDate.SpinButtonWeekUpClick(Sender: TObject);
begin
  ChangeDay(-7);
end;

procedure TFormAskDate.FormCreate(Sender: TObject);
var m:word;
    dt : TDateTime;
begin
//  DateTime.Date := Date;
  for m:=1 to 12 do begin
    dt := EncodeDate(1997,m,1);
    CBMonth.Items.Add(FormatDateTime('mmmm',dt));
  end;
  SyncDate;
  Edits[0] := EditDay;
  Edits[1] := EditMonth;
  Edits[2] := EditYear;
  activeEdit := 0;
end;

procedure TFormAskDate.DateTimeChange(Sender: TObject);
begin
  SyncCal;
end;

procedure TFormAskDate.CalChange(Sender: TObject);
begin
  SyncDate;
end;

procedure TFormAskDate.CBMonthChange(Sender: TObject);
var d,m,y:word;
begin
  DecodeDate(Cal.CalendarDate,y,m,d);
  m := CBMonth.ItemIndex+1;
  Cal.CalendarDate := EncodeDate(y,m,d);
  SyncCal;
end;

procedure TFormAskDate.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var k : word;
begin
  k := 0;
  case ( key ) of
    VK_NEXT   : ChangeMonth(+1);
    VK_PRIOR  : ChangeMonth(-1);
    VK_UP     : ChangeDay(-7);
    VK_DOWN   : ChangeDay(+7);
    VK_LEFT   : ChangeDay(-1);
    VK_RIGHT  : ChangeDay(+1);
    else k := key;
  end;
  key := k;
end;

function DoAskDate(q:string; var res : TDateTime; def : TDateTime) : boolean;
var fask : TFormAskDate;
begin
  if def = 0 then def := date;
  Result := false;
  fask := TFormAskDate.Create(NIL);
  if ( fask = NIL ) then exit;
  fask.Cal.CalendarDate := def;
  fask.Question.Caption := q;
//  fask.Cal.StartOfWeek := 0;
  if ( fask.ShowModal = mrOK ) then begin
    res := fask.Cal.CalendarDate;
    Result := true;
  end;
  fask.Free;
end;


function TFormAskDate.GetDay: integer;
var d,m,y:word;
begin
  DecodeDate(Cal.CalendarDate,y,m,d);
  Result := d;
end;

function TFormAskDate.GetMonth: integer;
var d,m,y:word;
begin
  DecodeDate(Cal.CalendarDate,y,m,d);
  Result := m;
end;

function TFormAskDate.GetWeek: integer;
var w,d,m,y:word;
begin
  DecodeDate(Cal.CalendarDate,y,m,d);
  w := weekno(1,m,y);
  Result := w;
end;

function TFormAskDate.GetYear: integer;
var d,m,y:word;
begin
  DecodeDate(Cal.CalendarDate,y,m,d);
  Result := y;
end;

procedure TFormAskDate.SetDay(const Value: integer);
var d,m,y:word;
begin
  if ( Day = Value ) then exit;
  DecodeDate(Cal.CalendarDate,y,m,d);
  try
    Cal.CalendarDate := EncodeDate(y,m,Value);
    SyncDate;
  except
  end;
end;

procedure TFormAskDate.SetMonth(const Value: integer);
var d,m,y:word;
begin
  if ( Day = Value ) then exit;
  DecodeDate(Cal.CalendarDate,y,m,d);
  try
    Cal.CalendarDate := EncodeDate(y,Value,d);
    SyncDate;
  except
  end;
end;

procedure TFormAskDate.SetYear(const Value: integer);
var d,m,y:word;
begin
  if ( Day = Value ) then exit;
  DecodeDate(Cal.CalendarDate,y,m,d);
  try
    Cal.CalendarDate := EncodeDate(Value,m,d);
    SyncDate;
  except
  end;
end;

procedure TFormAskDate.SetWeek(const Value: integer);
var w,d,m,y:word;
begin
//  LabelMonth.Caption := FormatDateTime('mmmm, yyyy',Cal.CalendarDate);
  DecodeDate(Cal.CalendarDate,y,m,d);
  w := weekno(d,m,y);
  if ( w = Value ) then exit;
  if ( Value < 1 ) or ( value > 53 ) then exit;
//  NoUpdate := true;
  ChangeDay((Value-w)*7);
//  NoUpdate := false;
end;

function toi(const sender:TObject; var i:integer):boolean;
begin
  Result := false;
  if ( not ( sender is TEdit ) ) then exit;
  i := StrToIntDef(TEdit(sender).Text,-1);
  if ( i < 0 ) then exit;
  Result := true;
end;

procedure TFormAskDate.EditWeekChange(Sender: TObject);
var i:integer;
begin
  if ( not toi(sender,i) ) then exit;
  Week := i;
end;

procedure TFormAskDate.EditDayChange(Sender: TObject);
var i:integer;
begin
  if ( not toi(sender,i) ) then exit;
  Day := i;
end;

procedure TFormAskDate.EditMonthChange(Sender: TObject);
var i:integer;
begin
  if ( not toi(sender,i) ) then exit;
  Month := i;
end;

procedure TFormAskDate.EditYearChange(Sender: TObject);
var i:integer;
begin
  if ( not toi(sender,i) ) then exit;
  Year := i;
end;


procedure TFormAskDate.ActionDotExecute(Sender: TObject);
begin
  if ActiveControl = Edits[0] then activeEdit := 0;
  if ( activeEdit < 2 ) then inc(activeEdit)
  else activeEdit := 0;
  ActiveControl := Edits[activeEdit];
end;
{$endif}

end.