jcllocales.pas

East make Tray Icon in delphi

  I: Integer;
begin
  Strings.BeginUpdate;
  try
    for I := 0 to Count - 1 do
      with Items[I] do
        Strings.AddObject(StringInfo[InfoType], Pointer(LocaleId));
  finally
    Strings.EndUpdate;
  end;
end;

function TJclLocalesList.GetCodePages: TStrings;
begin
  Result := FCodePages;
end;

function TJclLocalesList.GetItemFromLangID(LangID: LANGID): TJclLocaleInfo;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].LangID = LangID then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJclLocalesList.GetItemFromLangIDPrimary(LangIDPrimary: Word): TJclLocaleInfo;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].LangIDPrimary = LangIDPrimary then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJclLocalesList.GetItemFromLocaleID(LocaleID: LCID): TJclLocaleInfo;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].LocaleID = LocaleID then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJclLocalesList.GetItems(Index: Integer): TJclLocaleInfo;
begin
  Result := TJclLocaleInfo(inherited Items[Index]);
end;

//=== { TJclAvailableKeybLayout } ============================================

function TJclAvailableKeybLayout.GetIdentifierName: string;
begin
  Result := Format('%.8x', [FIdentifier]);
end;

function TJclAvailableKeybLayout.GetLayoutFileExists: Boolean;
begin
  Result := FileExists(PathAddSeparator(GetWindowsSystemFolder) + LayoutFile);
end;

function TJclAvailableKeybLayout.Load(const LoadFlags: TJclKeybLayoutFlags): Boolean;
begin
  Result := FOwner.LoadLayout(IdentifierName, LoadFlags);
end;

//=== { TJclKeyboardLayout } =================================================

constructor TJclKeyboardLayout.Create(AOwner: TJclKeyboardLayoutList; ALayout: HKL);
begin
  inherited Create;
  FLayout := ALayout;
  FOwner := AOwner;
end;

destructor TJclKeyboardLayout.Destroy;
begin
  FreeAndNil(FLocaleInfo);
  inherited Destroy;
end;

function TJclKeyboardLayout.Activate(ActivateFlags: TJclKeybLayoutFlags): Boolean;
begin
  Result := ActivateKeyboardLayout(FLayout, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF};
end;

function TJclKeyboardLayout.GetDeviceHandle: Word;
begin
  Result := HiWord(FLayout);
end;

function TJclKeyboardLayout.GetDisplayName: string;
begin
  Result := LocaleInfo.LocalizedLangName;
  if HiWord(FLayout) <> LoWord(FLayout) then
    Result := Result + ' - ' + VariationName;
end;

function TJclKeyboardLayout.GetLocaleID: Word;
begin
  Result := LoWord(FLayout);
end;

function TJclKeyboardLayout.GetLocaleInfo: TJclLocaleInfo;
begin
  if FLocaleInfo = nil then
    FLocaleInfo := TJclLocaleInfo.Create(MAKELCID(GetLocaleID, SORT_DEFAULT));
  Result := FLocaleInfo;
end;

function TJclKeyboardLayout.GetVariationName: string;
var
  I: Integer;
  Ident: DWORD;
begin
  Result := '';
  if HiWord(FLayout) = LoWord(FLayout) then
    Ident := LoWord(FLayout)
  else
    Ident := FLayout and $0FFFFFFF;
  with FOwner do
    for I := 0 to AvailableLayoutCount - 1 do
      with AvailableLayouts[I] do
        if (LoWord(Identifier) = LoWord(Ident)) and (LayoutID = HiWord(Ident)) then
        begin
          Result := Name;
          Break;
        end;
end;

function TJclKeyboardLayout.Unload: Boolean;
begin
  Result := Windows.UnloadKeyboardLayout(FLayout);
  if Result then
    FOwner.Refresh;
end;

//=== { TJclKeyboardLayoutList } =============================================

constructor TJclKeyboardLayoutList.Create;
begin
  inherited Create;
  FList := TObjectList.Create(True);
  CreateAvailableLayouts;
  Refresh;
end;

destructor TJclKeyboardLayoutList.Destroy;
begin
  FreeAndNil(FAvailableLayouts);
  FreeAndNil(FList);
  inherited Destroy;
end;

function TJclKeyboardLayoutList.ActivateNextLayout(ActivateFlags: TJclKeybLayoutFlags): Boolean;
begin
  Result := ActivateKeyboardLayout(HKL_NEXT, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF};
end;

function TJclKeyboardLayoutList.ActivatePrevLayout(
  ActivateFlags: TJclKeybLayoutFlags): Boolean;
begin
  Result := ActivateKeyboardLayout(HKL_PREV, KeybLayoutFlagsToDWORD(ActivateFlags, False)) {$IFNDEF FPC} <> 0 {$ENDIF};
end;

// Documentation:

// HOWTO: How to Find the Available Keyboard Layouts Under Windows NT
// Microsoft Knowledge Base Article - 139571
// http://support.microsoft.com/default.aspx?scid=kb;en-us;139571

// Description of Typical Control Subkeys of the HKLM Registry Key
// Microsoft Knowledge Base Article - 250447
// http://support.microsoft.com/default.aspx?scid=kb;en-us;250447

// http://www.microsoft.com/windows2000/techinfo/reskit/en-us/regentry/28326.asp

procedure TJclKeyboardLayoutList.CreateAvailableLayouts;
const
  cLayoutsKey = 'SYSTEM\CurrentControlSet\Control\Keyboard Layouts';
var
  I: Integer;
  KeyNames: TStringList;
  Item: TJclAvailableKeybLayout;
  Layout: string;
begin
  FAvailableLayouts := TObjectList.Create(True);
  KeyNames := TStringList.Create;
  try
    RegGetKeyNames(HKEY_LOCAL_MACHINE, cLayoutsKey, KeyNames);
    for I := 0 to KeyNames.Count - 1 do
    begin
      Layout := cLayoutsKey + '\' + KeyNames[I];
      Item := TJclAvailableKeybLayout.Create;
      Item.FOwner := Self;
      Item.FIdentifier := StrToIntDef('$' + KeyNames[I], 0);
      Item.FName := RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout Text', '');
      Item.FLayoutFile := RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout File', '');
      Item.FLayoutID := StrToIntDef('$' + RegReadStringDef(HKEY_LOCAL_MACHINE, Layout, 'Layout Id', ''), 0);
      FAvailableLayouts.Add(Item);
    end;
  finally
    KeyNames.Free;
  end;
end;

procedure TJclKeyboardLayoutList.DoRefresh;
begin
  if Assigned(FOnRefresh) then
    FOnRefresh(Self);
end;

function TJclKeyboardLayoutList.GetActiveLayout: TJclKeyboardLayout;
begin
  Result := ItemFromHKL[GetKeyboardLayout(0)];
end;

function TJclKeyboardLayoutList.GetAvailableLayoutCount: Integer;
begin
  Result := FAvailableLayouts.Count;
end;

function TJclKeyboardLayoutList.GetAvailableLayouts(Index: Integer): TJclAvailableKeybLayout;
begin
  Result := TJclAvailableKeybLayout(FAvailableLayouts[Index]);
end;

function TJclKeyboardLayoutList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TJclKeyboardLayoutList.GetItemFromHKL(Layout: HKL): TJclKeyboardLayout;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Layout = Layout then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJclKeyboardLayoutList.GetItems(Index: Integer): TJclKeyboardLayout;
begin
  Result := TJclKeyboardLayout(FList[Index]);
end;

function TJclKeyboardLayoutList.GetLayoutFromLocaleID(LocaleID: Word): TJclKeyboardLayout;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].LocaleID = LocaleID then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TJclKeyboardLayoutList.LoadLayout(const LayoutName: string;
  LoadFlags: TJclKeybLayoutFlags): Boolean;
begin
  Result := LoadKeyboardLayout(PChar(LayoutName),
    KeybLayoutFlagsToDWORD(LoadFlags, True)) <> 0;
  if Result then
    Refresh;
end;

procedure TJclKeyboardLayoutList.Refresh;
var
  Cnt, I: Integer;
  Layouts: array [1..JclMaxKeyboardLayouts] of HKL;
begin
  Cnt := Windows.GetKeyboardLayoutList(JclMaxKeyboardLayouts, Layouts);
  // Note: GetKeyboardLayoutList doesn't work as expected, when pass 0 to nBuff it always returns 0
  // on Win95.
  FList.Clear;
  for I := 1 to Cnt do
    FList.Add(TJclKeyboardLayout.Create(Self, Layouts[I]));
  DoRefresh;
end;

{ TODO : related MSDN entries, maybe to implement }
// Enabling the Shift Lock Feature on Windows NT 4.0
// Microsoft Knowledge Base Article - 174543
// http://support.microsoft.com/default.aspx?scid=kb;en-us;174543

//=== Various routines =======================================================

procedure JclLocalesInfoList(const Strings: TStrings; InfoType: Integer);
begin
  with TJclLocalesList.Create(lkInstalled) do
  try
    FillStrings(Strings, InfoType);
  finally
    Free;
  end;
end;

// History:

// $Log: JclLocales.pas,v $
// Revision 1.15  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.14  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.13  2005/02/06 03:37:52  mthoma
// Fixed [Code Library 0002479]: Wrong parameter count in callback function
//
// Revision 1.12  2004/10/17 21:00:15  mthoma
// cleaning
//
// Revision 1.11  2004/08/01 11:40:23  marquardt
// move constructors/destructors
//
// Revision 1.10  2004/07/31 06:21:03  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved
//
// Revision 1.9  2004/07/29 07:58:21  marquardt
// inc files updated
//
// Revision 1.8  2004/06/14 11:05:52  marquardt
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
//
// Revision 1.7  2004/05/13 07:46:06  rrossmair
// changes for FPC 1.9.3+ compatibility
//
// Revision 1.6  2004/05/06 05:09:55  rrossmair
// Changes for FPC v1.9.4 compatibility
//
// Revision 1.5  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.4  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.