• 0
DJ VK

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

Вопросы

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

1 ответ на этот вопрос

  • 0

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

Дни недели 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]);

 

Поделиться сообщением


Ссылка на сообщение
Поделиться на другие сайты

Для публикации сообщений создайте учётную запись или авторизуйтесь

Вы должны быть пользователем, чтобы оставить комментарий

Создать учетную запись

Зарегистрируйте новую учётную запись в нашем сообществе. Это очень просто!

Регистрация нового пользователя

Войти

Уже есть аккаунт? Войти в систему.

Войти


  • Похожий контент

    • От walexw
      rad studio 10 seattle
      Кидаю на форму TLang. Добавляю второй язык. Все надписи отсканировались, но нет никакой возможности ввести их переводы.
      Что бы я не делал, едиты для ввода значения на английском языке не появляются.
      Судя по нашему форуму, такая бага замечена еще в предыдущих версиях.
      Как быть?
    • От Schekhovtsov
      Чтобы если был выбран английский, приложение включало пресет английского. Собственно, нужен какой-то способ определения активного языка.
    • От Dozent
      Добрый день, переполненный эмоциями всё таки решил написать
      Что за непонятные глюки с этим компонентом?) То название возьмётся от пред идущего, то поменяешь один всё съехало, начинаешь выравнивать съезжает другое на -/+1 позицию.
  • Последние посетители   0 пользователей онлайн

    Ни одного зарегистрированного пользователя не просматривает данную страницу