DJ VK

Евгений Корепов · 16 марта, 2018

С Божией помощью решение было найдено.

Дни недели TLang кое-как видит, можно перевести стандартно в TLang.

Названия месяцев, теоретически, можно было бы подставить в стилях (calendarstyle, months.Items), но в FMX.Calendar.Style не предусмотрена очистка или проверка списка на отсутствие пользовательских значений, а идет добавление 12 месяцев из региональных настроек в конец списка, и это, фактически, ошибка в исходном коде fmx. Даже если этот способ бы и получился TLang не дает возможности перевести Items. И непонятно, удастся ли менять значения в ран-тайме. Поэтому перевод месяцев был сделан с помощью подмены стиля.

Спойлер


{*******************************************************}
{                                                       }
{              Delphi FireMonkey Platform               }
{                                                       }
{ Copyright(c) 2016 Embarcadero Technologies, Inc.      }
{              All rights reserved                      }
{                                                       }
{*******************************************************}

unit AdvFMXCalendarStyle;

interface

{$SCOPEDENUMS ON}

uses
  System.Classes, System.UITypes, FMX.ListBox, FMX.StdCtrls, FMX.ExtCtrls, FMX.Layouts, FMX.Controls,
  FMX.Presentation.Style, FMX.Presentation.Messages, FMX.Controls.Presentation, FMX.Controls.Model,
  FMX.Calendar.Style, FMX.Calendar;

const
  //MM_LOCALE_CHANGED = MM_USER + 5;
  MM_LOCALE_RUS = MM_USER + 6;
  MM_LOCALE_ENG = MM_USER + 7;
type

{ TAdvStyledCalendar }

  TAdvStyledCalendar = class(TStyledPresentation)
  public const
    CountOfVisibleDays = 6 * 7;
  private               
    FNeedChange: Boolean;
    FDateTime: TDateTime;
    FFirstDayOfWeekNum: Integer;
    FDisableDayChange: Integer;
    FMonths: TPopupBox;
    FYears: TPopupBox;
    FWeeks: TGridLayout;
    FWeek: TGridLayout;
    FDays: TListBox;
    FToday: TButton;
    FPrev: TButton;
    FNext: TButton;
    FLocaleID: string;
    procedure SetDate(Value: TDate);
    procedure SetDateTime(Value: TDateTime);
    function GetDate: TDate;
    function GetModel: TCalendarModel;
    procedure CalculateFirstDayOfWeek;
    procedure UpdateWeekWidth;
  protected
    { Messages from Model }
    procedure MMDateChanged(var AMessage: TDispatchMessageWithValue<TDateTime>); message MM_DATE_CHANGED;
    procedure MMWeekNumbersChanged(var AMessage: TDispatchMessageWithValue<Boolean>); message MM_WEEKNUMBERS_CHANGED;
    procedure MMFirstDayOfWeekChanged(var AMessage: TDispatchMessageWithValue<TCalDayOfWeek>); message MM_FIRSTDAYOFWEEK_CHANGED;
    //procedure MMLocaleChanged(var AMessage: TDispatchMessageWithValue<string>); message MM_LOCALE_CHANGED;
    procedure PMLocaleRus(var AMessage: TDispatchMessage); message MM_LOCALE_RUS;
    procedure PMLocaleEng(var AMessage: TDispatchMessage); message MM_LOCALE_ENG;
    { Messages from PresentationProxy }
    procedure PMInit(var AMessage: TDispatchMessage); message PM_INIT;
  protected
    /// <summary>Returns item index of item in FDays, which corresponds first day of current month</summary>
    function DefineItemIndexOfFirstDayInCurrentMonth: Integer;
    /// <summary>Fills years in <c>Years</c></summary>
    procedure FillYears; virtual;
    /// <summary>Fills week numbers in <c>Weeks</c></summary>
    procedure FillWeeksNumbers; virtual;
    /// <summary>Fills titles of days in current month in <c>Week</c></summary>
    procedure FillWeekDays; virtual;
    /// <summary>Fills days in current month in <c>Days</c></summary>
    procedure FillDays; virtual;
    /// <summary>Fills years, months, days, week numbers and etc.</summary>
    procedure FillCalendar;
    /// <summary>Updates height of items in Days and Week numbers lists</summary>
    procedure UpdateWeeksDaysItemHeight;

    procedure FillMonths;
    { Styles }
    procedure ApplyStyle; override;
    procedure FreeStyle; override;
    { Events }
    procedure DoChange; virtual;
    procedure DoDateSelected; virtual;
    procedure DoRealign; override;
    { Handlers }
    procedure DoPrevClick(Sender: TObject);
    procedure DoNextClick(Sender: TObject);
    procedure DoTodayClick(Sender: TObject);
    procedure DoMonthChange(Sender: TObject);
    procedure DoYearChange(Sender: TObject);
    procedure DoDayChange(Sender: TObject);
    procedure DoDayClick(const Sender: TCustomListBox; const Item: TListBoxItem);
    procedure DoDaysMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoDaysMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    { inherited }
    procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
    /// <summary>Defines <c>TCalendar</c> model class</summary>
    function DefineModelClass: TDataModelClass; override;
    /// <summary>Should we invoke OnChange, OnDateSelected events or not. If value more then 0, we shan't.</summary>
    property DisableDayChange: Integer read FDisableDayChange;
  public

    procedure SetLocaleID(const Value: string);

    /// <summary>Tries to find TListBoxItem, which corresponds a specified date. If current moneth doesn't have
    /// the ADateTime, it will returns nil</summary>
    function TryFindDayItem(const ADateTime: TDateTime): TListBoxItem;
    /// <summary>Current date in presentation</summary>
    property Date: TDate read GetDate write SetDate;
    /// <summary>Number of first day of week in vurrent locale and according <c>Model.FirstDayOfWeek</c></summary>
    property FirstDayOfWeek: Integer read FFirstDayOfWeekNum;
    /// <summary>Model of <c>TCalendar</c></summary>
    property Model: TCalendarModel read GetModel;
    { Access to style objects }
    /// <summary>List of years.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Years: TPopupBox read FYears;
    /// <summary>List of months.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Month: TPopupBox read FMonths;
    /// <summary>Grid of weeks numbers.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Weeks: TGridLayout read FWeeks;
    /// <summary>Grid of week day's titles.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Week: TGridLayout read FWeek;
    /// <summary>Grid of days.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Days: TListBox read FDays;
    /// <summary>Today button.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Today: TButton read FToday;
    /// <summary>Previous month button.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Prev: TButton read FPrev;
    /// <summary>Mext month button.</summary>
    /// <remarks>If style doesn't contain this element, it will return nil</remarks>
    property Next: TButton read FNext;
  end;

implementation

uses
  System.SysUtils, System.DateUtils, System.Math, FMX.Types, FMX.Platform, FMX.BehaviorManager, FMX.Presentation.Factory, FMX.ActnList;

type
  TDayItem = class(TListBoxItem)
  private
    FDate: TDateTime;
  public
    property Date: TDateTime read FDate write FDate;
  end;

{ TAdvStyledCalendar }

procedure TAdvStyledCalendar.ApplyStyle;

  function FindButtonAndAssignClickHandler(const AResourceName: string; const AClick: TNotifyEvent): TButton;
  var
    Button: TButton;
  begin
    if FindStyleResource<TButton>(AResourceName, Button) then
    begin
      Button.CanParentFocus := True;
      Button.OnClick := AClick;
      Result := Button;
    end
    else
      Result := nil;
  end;

var
  I: Integer;
  LLabel: TLabel;
  LItem: TListBoxItem;
  LocaleService: IFMXLocaleService;
begin
  inherited;
  // When user clicks on style elements or listbox with days, we need to transfer focus style to presentation.
  // For this purpose we set CanParentFocus.
  ResourceControl.CanParentFocus := True;

  FPrev := FindButtonAndAssignClickHandler('prev', DoPrevClick);
  FToday := FindButtonAndAssignClickHandler('today', DoTodayClick);
  FNext := FindButtonAndAssignClickHandler('next', DoNextClick);

  // Months
  if(FLocaleID = '') then
  begin
    FLocaleID := 'en-US';
    if TPlatformServices.Current.SupportsPlatformService(IFMXLocaleService, LocaleService) then
      FLocaleID := LocaleService.GetCurrentLangID;
  end;
  FillMonths;

  // Years
  if FindStyleResource<TPopupBox>('years', FYears) then
  begin
    FYears.CanParentFocus := True;
    FYears.BeginUpdate;
    try
      FillYears;
    finally
      FYears.EndUpdate;
    end;
    FYears.OnChange := DoYearChange;
  end;

  // Week
  if FindStyleResource<TGridLayout>('week', FWeek) then
  begin
    FWeek.CanParentFocus := True;
    FWeek.BeginUpdate;
    try
      for I := 0 to DaysPerWeek - 1 do
      begin
        LLabel := TLabel.Create(Self);
        LLabel.Parent := FWeek;
        LLabel.Locked := True;
        LLabel.Stored := False;
        LLabel.TextAlign := TTextAlign.Center;
        LLabel.WordWrap := False;
        LLabel.StyleLookup := 'calendarlabelstyle';
      end;
      UpdateWeekWidth;
      FillWeekDays;
    finally
      FWeek.EndUpdate;
    end;
  end;

  // Weeks
  if FindStyleResource<TGridLayout>('weeks', FWeeks) then
  begin
    FWeeks.CanParentFocus := True;
    FWeeks.Visible := Model.WeekNumbers;
    FWeeks.ItemWidth := FWeeks.Width;
    FWeeks.DeleteChildren;
    FWeeks.BeginUpdate;
    try
      for I := 0 to 5 do
      begin
        LLabel := TLabel.Create(Self);
        LLabel.Parent := FWeeks;
        LLabel.Locked := True;
        LLabel.Stored := False;
        LLabel.TextAlign := TTextAlign.Center;
        LLabel.WordWrap := False;
      end;
      FillWeeksNumbers;
    finally
      FWeeks.EndUpdate;
    end;
  end;

  // Days
  if FindStyleResource<TListBox>('days', FDays) then
  begin
    FDays.AniCalculations.TouchTracking := [];
    FDays.CanParentFocus := True;
    FDays.BeginUpdate;
    try
      for I := 1 to CountOfVisibleDays do
      begin
        LItem := TDayItem.Create(Self);
        LItem.Parent := FDays;
        LItem.Locked := True;
        LItem.Stored := False;
        LItem.TextAlign := TTextAlign.Center;
        LItem.StyledSettings := LItem.StyledSettings - [TStyledSetting.Other];
        LItem.WordWrap := False;
      end;
      FillDays;
      UpdateWeeksDaysItemHeight;
    finally
      FDays.EndUpdate;
    end;
    FDays.OnMouseDown := DoDaysMouseDown;
    FDays.OnMouseUp := DoDaysMouseUp;
    FDays.OnChange := DoDayChange;
    FDays.OnItemClick := DoDayClick;
  end;
end;

procedure TAdvStyledCalendar.CalculateFirstDayOfWeek;
var
  LocaleService: IFMXLocaleService;
begin
  if Model.FirstDayOfWeek = TCalDayOfWeek.dowLocaleDefault then
  begin
    if TPlatformServices.Current.SupportsPlatformService(IFMXLocaleService, LocaleService) then
      FFirstDayOfWeekNum := LocaleService.GetFirstWeekday
    else
      FFirstDayOfWeekNum := DayMonday;
  end
  else
    FFirstDayOfWeekNum := Ord(Model.FirstDayOfWeek) + 1;
end;

function TAdvStyledCalendar.DefineItemIndexOfFirstDayInCurrentMonth: Integer;
var
  Interval: Integer;
  BeginDate: TDateTime;
begin
  Interval := DaysPerWeek - FirstDayOfWeek;
  BeginDate := RecodeDay(FDateTime, 1);
  Result := (Interval + DayOfTheWeek(BeginDate)) mod DaysPerWeek + 1;
end;

function TAdvStyledCalendar.DefineModelClass: TDataModelClass;
begin
  Result := TCalendarModel;
end;

procedure TAdvStyledCalendar.DoChange;
begin
  Model.DisableNotify;
  try
    Model.DateTime := Date;
  finally
    Model.EnableNotify;
  end;

  if (FDisableDayChange = 0) and Assigned(Model.OnChange) then
    Model.OnChange(PresentedControl);
end;

procedure TAdvStyledCalendar.DoDateSelected;
begin
  if Assigned(Model.OnDateSelected) then
    Model.OnDateSelected(PresentedControl);
end;

procedure TAdvStyledCalendar.DoDayChange(Sender: TObject);
begin
  if (FDays = nil) or (FDays.Selected = nil) then
    Exit;
  Date := (FDays.Selected as TDayItem).Date;
  if FDisableDayChange = 0 then
    DoDateSelected;
  FDays.ItemDown := nil;
end;

procedure TAdvStyledCalendar.DoDayClick(const Sender: TCustomListBox; const Item: TListBoxItem);
begin
  if Assigned(Model.OnDayClick) then
    Model.OnDayClick(PresentedControl);
end;

procedure TAdvStyledCalendar.DoDaysMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if FDisableDayChange = 0 then
    Inc(FDisableDayChange);
end;

procedure TAdvStyledCalendar.DoDaysMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if FDisableDayChange > 0 then
  begin
    Dec(FDisableDayChange);
    if (FDisableDayChange = 0) and FNeedChange then
    begin
      FNeedChange := False;
      DoChange;
      DoDateSelected;
    end;
  end;
end;

procedure TAdvStyledCalendar.DoMonthChange(Sender: TObject);
var
  AYear, AMonth, ADay: Word;
  DaysInMonth: Word;
begin
  DecodeDate(FDateTime, AYear, AMonth, ADay);
  DaysInMonth := DaysInAMonth(AYear, FMonths.ItemIndex + 1);
  ADay := Min(ADay, DaysInMonth);
  Date := EncodeDate(AYear, FMonths.ItemIndex + 1, ADay);
  DoChange;
end;

procedure TAdvStyledCalendar.DoNextClick(Sender: TObject);
begin
  Date := IncMonth(Date);
  DoChange;
end;

procedure TAdvStyledCalendar.DoPrevClick(Sender: TObject);
begin
  Date := IncMonth(Date, -1);
  DoChange;
end;

procedure TAdvStyledCalendar.DoRealign;
begin
  inherited;
  UpdateWeekWidth;
  UpdateWeeksDaysItemHeight;
end;

procedure TAdvStyledCalendar.DoTodayClick(Sender: TObject);
begin
  Date := Now;
  DoChange;
  if FDisableDayChange = 0 then
    DoDateSelected;
end;

procedure TAdvStyledCalendar.DoYearChange(Sender: TObject);
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(FDateTime, AYear, AMonth, ADay);
  ADay := Min(ADay, DaysInAMonth(FYears.Text.ToInteger, AMonth));
  Date := EncodeDate(FYears.Text.ToInteger, AMonth, ADay);
  DoChange;
end;

procedure TAdvStyledCalendar.FillDays;
const
  DisabledDaysOpacity = 0.3;
  EnabledDaysOpacity = 1;
var
  First: Word;

  function DefinePreviousMonth: Word;
  begin
    Result := MonthOf(FDateTime) - 1;
    if Result < MonthJanuary then
      Result := MonthDecember;
  end;

  function DefineNextMonth: Word;
  begin
    Result := MonthOf(FDateTime) + 1;
    if Result > MonthDecember then
      Result := MonthJanuary;
  end;

  function DefineYearOfPreviousMonth: Word;
  begin
    if DefinePreviousMonth = MonthDecember then
      Result := YearOf(FDateTime) - 1
    else
      Result := YearOf(FDateTime);
  end;

  function DefineYearOfNextMonth: Word;
  begin
    if DefineNextMonth = MonthJanuary then
      Result := YearOf(FDateTime) + 1
    else
      Result := YearOf(FDateTime);
  end;

  procedure FillDaysOfPreviousMonth;
  var
    PrevMonth: Word;
    Year: Word;
    DaysInMonthTmp: Word;
    I: Integer;
    Item: TDayItem;
    Day: Word;
    PrevYear: Word;
  begin
    Year := YearOf(FDateTime);
    PrevYear := DefineYearOfPreviousMonth;
    PrevMonth := DefinePreviousMonth;
    DaysInMonthTmp := DaysInAMonth(Year, PrevMonth);
    for I := 1 to First - 1 do
    begin
      Item := FDays.ListItems[I - 1] as TDayItem;
      Item.Opacity := DisabledDaysOpacity;
      Day := DaysInMonthTmp - (First - 1) + I;
      Item.Text := Day.ToString;
      Item.Date := EncodeDate(PrevYear, PrevMonth, Day);
    end;
  end;

  procedure FillDaysOfCurrentMonth;
  var
    DaysInMonthTmp: Word;
    I: Word;
    Item: TDayItem;
    Day: Word;
  begin
    DaysInMonthTmp := DaysInMonth(FDateTime);
    for I := First to First + DaysInMonthTmp - 1 do
    begin
      Item := FDays.ListItems[I - 1] as TDayItem;
      Item.Opacity := EnabledDaysOpacity;
      Day := I - First + 1;
      Item.Text := Day.ToString;
      Item.Date := RecodeDay(FDateTime, Day);
    end;
  end;

  procedure FillDaysOfNextMonth;
  var
    DaysInMonthTmp: Word;
    I: Word;
    Item: TDayItem;
    NextMonth: Word;
    NextYear: Word;
    Day: Word;
  begin
    DaysInMonthTmp := DaysInMonth(FDateTime);
    NextMonth := DefineNextMonth;
    NextYear := DefineYearOfNextMonth;
    for I := First + DaysInMonthTmp to FDays.Count do
    begin
      Item := FDays.ListItems[I - 1] as TDayItem;
      Item.Opacity := DisabledDaysOpacity;
      Day := I - First - DaysInMonthTmp + 1;
      Item.Text := Day.ToString;
      Item.Date := EncodeDate(NextYear, NextMonth, Day);
    end;
  end;

begin
  if (FDays = nil) or (FDays.Count <> CountOfVisibleDays) then
    Exit;

  First := DefineItemIndexOfFirstDayInCurrentMonth;

  FillDaysOfPreviousMonth;
  FillDaysOfCurrentMonth;
  FillDaysOfNextMonth;

  FDays.ItemIndex := (First - 1) + DayOf(FDateTime) - 1;
end;

procedure TAdvStyledCalendar.FillCalendar;
begin
  if IsUpdating then
    Exit;

  FDisableDayChange := FDisableDayChange + 1;
  try
    FillWeekDays;
    FillDays;
    FillYears;
    FillWeeksNumbers;
    FillMonths;
    if FMonths <> nil then
      FMonths.ItemIndex := MonthOf(FDateTime) - 1;
  finally
    FDisableDayChange := FDisableDayChange - 1;
  end;
end;

procedure TAdvStyledCalendar.UpdateWeeksDaysItemHeight;
const 
  DaysLines = 6;
begin
  if FDays <> nil then
    FDays.ItemHeight := FDays.Height / DaysLines;
  if FWeeks <> nil then
    FWeeks.ItemHeight := FWeeks.Height / DaysLines;
end;

procedure TAdvStyledCalendar.FillWeekDays;
var
  I: Integer;
  Day: Integer;
  CaptionControl: ICaption;
begin
  if FWeek = nil then
    Exit;

  for I := 0 to DaysPerWeek - 1 do
    if Supports(FWeek.Controls[I], ICaption, CaptionControl) then
    begin
      Day := (I + FFirstDayOfWeekNum) mod DaysPerWeek;
      CaptionControl.Text := FormatSettings.ShortDayNames[1 + Day];
    end;
end;

procedure TAdvStyledCalendar.FillWeeksNumbers;
var
  I: Integer;
  CaptionControl: ICaption;
  FirstWeekOfMonth: Byte;
  WeekCorrection: Integer;
begin
  if FWeeks = nil then
    Exit;

  FWeeks.Visible := Model.WeekNumbers;

  // WeekOfTheYear doesn't consider a current Locale. So for 01.01.2017 returns 52.
  if MonthOf(FDateTime) = MonthJanuary then
    FirstWeekOfMonth := 1
  else
    FirstWeekOfMonth := WeekOfTheYear(RecodeDay(FDateTime, 1));

  // First week in FDay may be a last week of previous month. So we need to keep offset for correct counting of weeks.
  WeekCorrection := (DefineItemIndexOfFirstDayInCurrentMonth - 1) div 7;
  for I := 0 to FWeeks.ControlsCount - 1 do
    if Supports(FWeeks.Controls[I], ICaption, CaptionControl) then
      CaptionControl.Text := (FirstWeekOfMonth + I - WeekCorrection).ToString;
end;

procedure TAdvStyledCalendar.FillYears;
const
  HalfCountOfYearsInPopupBox = 5;
var
  SavedYearChanged: TNotifyEvent;
  Year: Integer;
  SelectedYear: Word;
begin
  if FYears = nil then
    Exit;

  SavedYearChanged := FYears.OnChange;
  FYears.OnChange := nil;
  try
    FYears.BeginUpdate;
    try
      FYears.Items.Clear;
      SelectedYear := YearOf(FDateTime);
      for Year := SelectedYear - HalfCountOfYearsInPopupBox to SelectedYear + HalfCountOfYearsInPopupBox do
        FYears.Items.Add(Year.ToString);
      FYears.Text := SelectedYear.ToString;
    finally
      FYears.EndUpdate;
    end;
  finally
    FYears.OnChange := SavedYearChanged;
  end;
end;

procedure TAdvStyledCalendar.FillMonths;
var
  MonthName: string;
  FS: TFormatSettings;
begin
  inherited;

  // Months
  if FindStyleResource<TPopupBox>('months', FMonths) then
  begin
    FMonths.CanParentFocus := True;
    FMonths.BeginUpdate;
    try
      FMonths.ItemIndex := -1;
      FMonths.Items.Clear;
      FS := TFormatSettings.Create(FLocaleID);
      for MonthName in FS.LongMonthNames do
        FMonths.Items.Add(MonthName);
      FMonths.ItemIndex := MonthOf(FDateTime) - 1;
    finally
      FMonths.EndUpdate;
    end;
    FMonths.OnChange := DoMonthChange;
  end;
end;


procedure TAdvStyledCalendar.FreeStyle;
begin
  inherited;
  if FPrev <> nil then
    FPrev.OnClick := nil;
  FPrev := nil;
  if FToday <> nil then
    FToday.OnClick := nil;
  FToday := nil;
  if FNext <> nil then
    FNext.OnClick := nil;
  FNext := nil;
  if FMonths <> nil then
    FMonths.OnChange := nil;
  FMonths := nil;
  if FYears <> nil then
    FYears.OnChange := DoYearChange;
  FYears := nil;
  FWeek := nil;
  FWeeks := nil;
  if FDays <> nil then
  begin
    FDays.OnMouseDown := DoDaysMouseDown;
    FDays.OnMouseUp := DoDaysMouseUp;
    FDays.OnChange := DoDayChange;
    FDays.OnItemClick := DoDayClick;
  end;
  FDays := nil;
end;

function TAdvStyledCalendar.GetDate: TDate;
begin
  Result := Trunc(FDateTime);
end;

function TAdvStyledCalendar.GetModel: TCalendarModel;
begin
  Result := inherited GetModel<TCalendarModel>;
end;

procedure TAdvStyledCalendar.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
begin
  inherited;
  case Key of
    vkLeft:
      begin
        if ([ssCtrl, ssCommand] * Shift) <> [] then
          Date := IncMonth(Date, -1)
        else
          Date := IncDay(Date, -1);
        DoChange;
        Key := 0;
        KeyChar := #0;
      end;
    vkRight:
      begin
        if ([ssCtrl, ssCommand] * Shift) <> [] then
          Date := IncMonth(Date)
        else
          Date := IncDay(Date);
        DoChange;
        Key := 0;
        KeyChar := #0;
      end;
    vkUp:
      if ([ssCtrl, ssCommand] * Shift) = [] then
      begin
        Date := IncDay(Date, -7);
        DoChange;
        Key := 0;
        KeyChar := #0;
      end;
    vkDown:
      if ([ssCtrl, ssCommand] * Shift) = [] then
      begin
        Date := IncDay(Date, 7);
        DoChange;
        Key := 0;
        KeyChar := #0;
      end;
  end;
end;

procedure TAdvStyledCalendar.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
begin
  inherited;
  if not Handled then
  begin
    if WheelDelta > 0 then
      Date := IncMonth(Date, -1)
    else
      Date := IncMonth(Date);
    Handled := True;
  end;
end;

procedure TAdvStyledCalendar.PMInit(var AMessage: TDispatchMessage);
begin
  BeginUpdate;
  try
    Date := Model.DateTime;
  finally
    EndUpdate;
  end;
  CalculateFirstDayOfWeek;
  FillCalendar;
end;

procedure TAdvStyledCalendar.SetDate(Value: TDate);
begin
  FDisableDayChange := FDisableDayChange + 1;
  try
    ReplaceTime(TDateTime(Value), FDateTime);
    try
      SetDateTime(Value);
    except
      SetDateTime(FDateTime);
      raise;
    end;
  finally
    FDisableDayChange := FDisableDayChange - 1;
  end;
end;

procedure TAdvStyledCalendar.SetDateTime(Value: TDateTime);
begin
  if not SameDateTime(FDateTime, Value) then
  begin
    FDateTime := Value;
    if not (csDestroying in ComponentState) and not Released then
    begin
      FillCalendar;
      if FDisableDayChange = 0 then
        DoChange
      else
        FNeedChange := True;
    end;
  end;
end;

function TAdvStyledCalendar.TryFindDayItem(const ADateTime: TDateTime): TListBoxItem;
var
  FirstVisibleDayItem: TDayItem;
  LastVisibleDayItem: TDayItem;
  I: Integer;
begin
  Result := nil;
  if (FDays = nil) or (FDays.Count = 0) then
    Exit;

  FirstVisibleDayItem := FDays.ListItems[0] as TDayItem;
  LastVisibleDayItem := FDays.ListItems[FDays.Count - 1] as TDayItem;

  if DateInRange(ADateTime, FirstVisibleDayItem.Date, LastVisibleDayItem.Date) then
    for I := 0 to FDays.Count - 1 do
      if SameDate(TDayItem(FDays.ListItems[I]).Date, ADateTime) then
        Exit(FDays.ListItems[I]);
end;

procedure TAdvStyledCalendar.UpdateWeekWidth;
begin
  if FWeek <> nil then
    FWeek.ItemWidth := Floor(FWeek.Width / DaysPerWeek);
end;

procedure TAdvStyledCalendar.MMDateChanged(var AMessage: TDispatchMessageWithValue<TDateTime>);
begin
  SetDateTime(AMessage.Value);
end;

procedure TAdvStyledCalendar.MMFirstDayOfWeekChanged(var AMessage: TDispatchMessageWithValue<TCalDayOfWeek>);
begin
  CalculateFirstDayOfWeek;
  FillCalendar;
end;

procedure TAdvStyledCalendar.MMWeekNumbersChanged(var AMessage: TDispatchMessageWithValue<Boolean>);
begin
  FillCalendar;
  Realign;
end;

//procedure TAdvStyledCalendar.MMLocaleChanged(var AMessage: TDispatchMessageWithValue<string>);
//begin
//  SetLocaleID(AMessage.Value);
//end;

procedure TAdvStyledCalendar.PMLocaleRus(var AMessage: TDispatchMessage);
begin
  SetLocaleID('ru-RU');
end;

procedure TAdvStyledCalendar.PMLocaleEng(var AMessage: TDispatchMessage);
begin
  SetLocaleID('en-US');
end;

procedure TAdvStyledCalendar.SetLocaleID(const Value: string);
begin
  FLocaleID := Value;
  FillCalendar;
end;

initialization
  TPresentationProxyFactory.Current.Unregister(TCalendar, TControlType.Styled, TStyledPresentationProxy<TStyledCalendar>);
  TPresentationProxyFactory.Current.Register(TCalendar, TControlType.Styled, TStyledPresentationProxy<TAdvStyledCalendar>);
finalization
  TPresentationProxyFactory.Current.Unregister(TCalendar, TControlType.Styled, TStyledPresentationProxy<TAdvStyledCalendar>);
end.

Я изначально пытался сделать одно управляющее событие с кодом языка. Но с++ вызов шаблона TCalendar->Model->SendMessage<UnicodeString> линкер ни в какую принимать не захотел, поэтому сделал по одному простому сообщению без параметров на каждый язык. Вызов

switch(Lang)
	{
		case 0:
			L = "ru";
			BDay->Model->SendMessage(MM_LOCALE_RUS);
			EDay->Model->SendMessage(MM_LOCALE_RUS);
			break;
		case 1:
			L = "en";
			BDay->Model->SendMessage(MM_LOCALE_ENG);
			EDay->Model->SendMessage(MM_LOCALE_ENG);
			break;
	}

	LoadLangFromStrings(Lang1->LangStr[L]);

14 марта, 2018

Как поддержать разные названия месяцев и дней недели календаря для разных языков?

Войти

DJ VK

Постов

Зарегистрирован

Посещение

Тип контента

Профили

Форумы

Сообщения, опубликованные DJ VK

Локализация названий месяцев и дней недели в календаре

Локализация названий месяцев и дней недели в календаре

Сайт

FGX

Активность