jcllocales.pas

East make Tray Icon in delphi

  FreeAndNil(FCalendars);
  for DateFormat := Low(DateFormat) to High(DateFormat) do
    FreeAndNil(FDateFormats[DateFormat]);
  FreeAndNil(FTimeFormats);
  inherited Destroy;
end;

function TJclLocaleInfo.GetAbbreviatedDayNames(Day: TJclLocalesDays): string;
begin
  Result := GetStringInfo(LOCALE_SABBREVDAYNAME1 + Day - 1);
end;

function TJclLocaleInfo.GetAbbreviatedMonthNames(Month: TJclLocalesMonths): string;
var
  Param: DWORD;
begin
  case Month of
    1..12:
      Param := LOCALE_SABBREVMONTHNAME1 + Month - 1;
    13:
      Param := LOCALE_SABBREVMONTHNAME13;
  else
    raise ERangeError.CreateRes(@SRangeError);
  end;
  Result := GetStringInfo(Param);
end;

function TJclLocaleInfo.GetCalendarIntegerInfo(Calendar: CALID; InfoType: Integer): Integer;
var
  Ret: DWORD;
begin
  InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]) or CAL_RETURN_NUMBER;
  Ret := JclWin32.RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, nil, 0, @Result);
  if Ret = 0 then
    Ret := JclWin32.RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, nil, 0, @Result);
  if Ret = 0 then
    Result := 0;
end;


function EnumCalendarInfoProcEx(lpCalendarInfoString: PChar; Calendar: CALID): BOOL; stdcall;
begin
  ProcessedLocaleInfoList.AddObject(lpCalendarInfoString, Pointer(Calendar));
  Result := True;
end;

function EnumCalendarInfoProcName(lpCalendarInfoString: PChar): BOOL; stdcall;
begin
  ProcessedLocaleInfoList.Add(lpCalendarInfoString);
  Result := True;
end;

function TJclLocaleInfo.GetCalendars: TStrings;
var
  C: CALTYPE;

begin
  if not FValidCalendars then
  begin
    if FCalendars = nil then
      FCalendars := TStringList.Create
    else
      FCalendars.Clear;
    ProcessedLocaleInfoList := FCalendars;
    try
      C := CAL_SCALNAME or LocaleUseAcp[FUseSystemACP];
      if not JclWin32.RtdlEnumCalendarInfoExA(EnumCalendarInfoProcEx, FLocaleID, ENUM_ALL_CALENDARS, C) then
        Windows.EnumCalendarInfo(@EnumCalendarInfoProcName, FLocaleID, ENUM_ALL_CALENDARS, C);
      FValidCalendars := True;
    finally
      ProcessedLocaleInfoList := nil;
    end;
  end;
  Result := FCalendars;
end;

function TJclLocaleInfo.GetCalendarStringInfo(Calendar: CALID; InfoType: Integer): string;
var
  Buffer: Pointer;
  BufferSize: Integer;
  Ret: DWORD;
begin
  Result := '';
  InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]);
  Buffer := nil;
  try
    BufferSize := 128;
    repeat
      ReallocMem(Buffer, BufferSize);
      Ret := RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, Buffer, BufferSize, nil);
      if (Ret = 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
        BufferSize := RtdlGetCalendarInfoW(FLocaleID, Calendar, InfoType, Buffer, 0, nil) * 2;
    until (Ret > 0) or (GetLastError <> ERROR_INSUFFICIENT_BUFFER);
    if Ret > 0 then
      Result := PWideChar(Buffer)
    else
    begin
      BufferSize := 64;
      repeat
        ReallocMem(Buffer, BufferSize);
        Ret := RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, Buffer, BufferSize, nil);
        if (Ret = 0) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
          BufferSize := RtdlGetCalendarInfoA(FLocaleID, Calendar, InfoType, Buffer, 0, nil);
      until (Ret > 0) or (GetLastError <> ERROR_INSUFFICIENT_BUFFER);
      if Ret > 0 then
        Result := PChar(Buffer);
    end;
  finally
    FreeMem(Buffer);
  end;
end;

function TJclLocaleInfo.GetCharInfo(InfoType: Integer): Char;
var
  S: string;
begin
  S := GetStringInfo(InfoType);
  if Length(S) >= 1 then
    Result := S[1]
  else
    Result := ' ';
end;

function TJclLocaleInfo.GetDateFormats(Format: TJclLocaleDateFormats): TStrings;
const
  DateFormats: array [TJclLocaleDateFormats] of DWORD =
    (DATE_SHORTDATE, DATE_LONGDATE, DATE_YEARMONTH);

  function EnumDateFormatsProc(lpDateFormatString: LPSTR): BOOL; stdcall;
  begin
    ProcessedLocaleInfoList.Add(lpDateFormatString);
    DWORD(Result) := 1;
  end;

begin
  if not (Format in FValidDateFormatLists) then
  begin
    if FDateFormats[Format] = nil then
      FDateFormats[Format] := TStringList.Create
    else
      FDateFormats[Format].Clear;
    ProcessedLocaleInfoList := FDateFormats[Format];
    try
      Windows.EnumDateFormats(@EnumDateFormatsProc, FLocaleID, DateFormats[Format] or
        LocaleUseAcp[FUseSystemACP]);
      Include(FValidDateFormatLists, Format);
    finally
      ProcessedLocaleInfoList := nil;
    end;
  end;
  Result := FDateFormats[Format];
end;

function TJclLocaleInfo.GetFontCharset: Byte;
type
  TCharsetEntry = record
    CodePage: Word;
    Charset: Byte;
  end;
const
  CharsetTable: array [1..10] of TCharsetEntry =
   (
    (CodePage: 1252; Charset: ANSI_CHARSET),
    (CodePage: 1250; Charset: EASTEUROPE_CHARSET),
    (CodePage: 1251; Charset: RUSSIAN_CHARSET),
    (CodePage: 1253; Charset: GREEK_CHARSET),
    (CodePage: 1254; Charset: TURKISH_CHARSET),
    (CodePage: 1255; Charset: HEBREW_CHARSET),
    (CodePage: 1256; Charset: ARABIC_CHARSET),
    (CodePage: 1257; Charset: BALTIC_CHARSET),
    (CodePage:  874; Charset: THAI_CHARSET),
    (CodePage:  932; Charset: SHIFTJIS_CHARSET)
   );
var
  I, CpANSI: Integer;
begin
  Result := DEFAULT_CHARSET;
  CpANSI := CodePageANSI;
  for I := Low(CharsetTable) to High(CharsetTable) do
    if CharsetTable[I].CodePage = CpANSI then
    begin
      Result := CharsetTable[I].Charset;
      Break;
    end;
end;

function TJclLocaleInfo.GetIntegerInfo(InfoType: Integer): Integer;
begin
  Result := StrToIntDef(GetStringInfo(InfoType), 0);
end;

function TJclLocaleInfo.GetLangID: LANGID;
begin
  Result := LANGIDFROMLCID(FLocaleID);
end;

function TJclLocaleInfo.GetLangIDPrimary: Word;
begin
  Result := PRIMARYLANGID(LangID);
end;

function TJclLocaleInfo.GetLangIDSub: Word;
begin
  Result := SUBLANGID(LangID);
end;

function TJclLocaleInfo.GetLongDayNames(Day: TJclLocalesDays): string;
begin
  Result := GetStringInfo(LOCALE_SDAYNAME1 + Day - 1);
end;

function TJclLocaleInfo.GetLongMonthNames(Month: TJclLocalesMonths): string;
var
  Param: DWORD;
begin
  if Month = 13 then
    Param := LOCALE_SMONTHNAME13
  else
    Param := LOCALE_SMONTHNAME1 + Month - 1;
  Result := GetStringInfo(Param);
end;

function TJclLocaleInfo.GetSortID: Word;
begin
  Result := SORTIDFROMLCID(FLocaleID);
end;

function TJclLocaleInfo.GetStringInfo(InfoType: Integer): string;
var
  Res: Integer;
  W: PWideChar;
begin
  InfoType := InfoType or Integer(LocaleUseAcp[FUseSystemACP]);
  Res := GetLocaleInfoA(FLocaleID, InfoType, nil, 0);
  if Res > 0 then
  begin
    SetString(Result, nil, Res);
    Res := Windows.GetLocaleInfoA(FLocaleID, InfoType, PChar(Result), Res);
    StrResetLength(Result);
    // Note: GetLocaleInfo returns sometimes incorrect length of string on Win95 (usually plus 1),
    // that's why StrResetLength is called.
  end
  else  // GetLocaleInfoA failed
  if IsWinNT then
  begin
    Res := GetLocaleInfoW(FLocaleID, InfoType, nil, 0);
    if Res > 0 then
    begin
      GetMem(W, Res * SizeOf(WideChar));
      Res := Windows.GetLocaleInfoW(FLocaleID, InfoType, W, Res);
      Result := WideCharToString(W);
      FreeMem(W);
    end;
  end;
  if Res = 0 then
    Result := '';
end;

function TJclLocaleInfo.GetTimeFormats: TStrings;

  function EnumTimeFormatsProc(lpTimeFormatString: LPSTR): BOOL; stdcall;
  begin
    ProcessedLocaleInfoList.Add(lpTimeFormatString);
    DWORD(Result) := 1;
  end;

begin
  if not FValidTimeFormatLists then
  begin
    if FTimeFormats = nil then
      FTimeFormats := TStringList.Create
    else
      FTimeFormats.Clear;
    ProcessedLocaleInfoList := FTimeFormats;
    try
      Windows.EnumTimeFormats(@EnumTimeFormatsProc, FLocaleID, LocaleUseAcp[FUseSystemACP]);
      FValidTimeFormatLists := True;
    finally
      ProcessedLocaleInfoList := nil;
    end;
  end;
  Result := FTimeFormats;
end;

procedure TJclLocaleInfo.SetCharInfo(InfoType: Integer; const Value: Char);
begin
  SetStringInfo(InfoType, Value);
end;

procedure TJclLocaleInfo.SetIntegerInfo(InfoType: Integer; const Value: Integer);
begin
  SetStringInfo(InfoType, IntToStr(Value));
end;

procedure TJclLocaleInfo.SetStringInfo(InfoType: Integer; const Value: string);
begin
  Win32Check(Windows.SetLocaleInfo(FLocaleID, InfoType, PChar(Value)));
end;

procedure TJclLocaleInfo.SetUseSystemACP(const Value: Boolean);
begin
  if FUseSystemACP <> Value then
  begin
    FUseSystemACP := Value;
    FValidCalendars := False;
    FValidDateFormatLists := [];
    FValidTimeFormatLists := False;
  end;
end;

//=== { TJclLocalesList } ====================================================

constructor TJclLocalesList.Create(AKind: TJclLocalesKind);
begin
  inherited Create(True);
  FCodePages := TStringList.Create;
  FKind := AKind;
  CreateList;
end;

destructor TJclLocalesList.Destroy;
begin
  FreeAndNil(FCodePages);
  inherited Destroy;
end;

procedure TJclLocalesList.CreateList;
const
  Flags: array [TJclLocalesKind] of DWORD = (LCID_INSTALLED, LCID_SUPPORTED);

  function EnumLocalesProc(lpLocaleString: LPSTR): BOOL; stdcall;
  var
    LocaleID: LCID;
  begin
    LocaleID := StrToIntDef('$' + Copy(lpLocaleString, 5, 4), 0);
    if LocaleID > 0 then
      ProcessedLocalesList.Add(TJclLocaleInfo.Create(LocaleID));
    DWORD(Result) := 1;
  end;

  function EnumCodePagesProc(lpCodePageString: LPSTR): BOOL; stdcall;
  begin
    ProcessedLocalesList.CodePages.AddObject(lpCodePageString, Pointer(StrToIntDef(lpCodePageString, 0)));
    DWORD(Result) := 1;
  end;

begin
  ProcessedLocalesList := Self;
  try
    Win32Check(Windows.EnumSystemLocales(@EnumLocalesProc, Flags[FKind]));
    Win32Check(Windows.EnumSystemCodePages(@EnumCodePagesProc, Flags[FKind]));
  finally
    ProcessedLocalesList := nil;
  end;
end;

procedure TJclLocalesList.FillStrings(Strings: TStrings; InfoType: Integer);
var