Стартовый пул

KASToolBar/dwtaskbarlist.pas

@@ -0,0 +1,208 @@
+unit dwTaskbarList;
+
+{$mode delphi}{$H+}
+
+interface
+
+uses
+  Messages
+  , Windows
+  ;
+
+const
+  CLSID_TaskbarList: TGUID = '{56FDF344-FD6D-11D0-958A-006097C9A090}';
+  CLSID_TaskbarList2: TGUID = '{602D4995-B13A-429B-A66E-1935E44F4317}';
+  CLSID_TaskbarList3: TGUID = '{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}';
+
+const
+  THBF_ENABLED = $0000;  
+  THBF_DISABLED = $0001;
+  THBF_DISMISSONCLICK = $0002;
+  THBF_NOBACKGROUND = $0004;
+  THBF_HIDDEN = $0008;
+
+const
+  THB_BITMAP = $0001;
+  THB_ICON = $0002;
+  THB_TOOLTIP = $0004;
+  THB_FLAGS = $0008;
+
+const
+  THBN_CLICKED = $1800;
+
+const
+  TBPF_NOPROGRESS	= $00;
+	TBPF_INDETERMINATE = $01;
+	TBPF_NORMAL	= $02;
+	TBPF_ERROR= $04;
+	TBPF_PAUSED	= $08;
+
+const
+  TBATF_USEMDITHUMBNAIL: DWORD = $00000001;
+  TBATF_USEMDILIVEPREVIEW: DWORD = $00000002;
+  
+const
+  WM_DWMSENDICONICTHUMBNAIL = $0323;
+  WM_DWMSENDICONICLIVEPREVIEWBITMAP = $0326;
+
+type
+  TTipString = array[0..259] of WideChar;
+  PTipString = ^TTipString;
+  tagTHUMBBUTTON = packed record
+    dwMask
+      : DWORD;
+    iId
+    , iBitmap
+      : UINT;
+    hIcon
+      : HICON;
+    szTip
+      : TTipString;
+    dwFlags
+      : DWORD;
+  end;
+  THUMBBUTTON = tagTHUMBBUTTON;
+  THUMBBUTTONLIST = ^THUMBBUTTON;
+  TThumbButton = THUMBBUTTON;
+  TThumbButtonList = array of TThumbButton;
+
+type
+  ITaskbarList = interface
+    ['{56FDF342-FD6D-11D0-958A-006097C9A090}']
+    procedure HrInit; safecall;
+    procedure AddTab(hwnd: HWND); safecall;
+    procedure DeleteTab(hwnd: HWND); safecall;
+    procedure ActivateTab(hwnd: HWND); safecall;
+    procedure SetActiveAlt(hwnd: HWND); safecall;
+  end;
+
+  ITaskbarList2 = interface(ITaskbarList)
+    ['{602D4995-B13A-429B-A66E-1935E44F4317}']
+    procedure MarkFullscreenWindow(hwnd: HWND; fFullscreen: Bool); safecall;
+  end;
+
+  ITaskbarList3 = interface(ITaskbarList2)
+    ['{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}']
+    procedure SetProgressValue(hwnd: HWND; ullCompleted, ullTotal: ULONGLONG); safecall;
+    procedure SetProgressState(hwnd: HWND; tbpFlags: DWORD); safecall;
+    procedure RegisterTab(hwndTab: HWND; hwndMDI: HWND); safecall;
+    procedure UnregisterTab(hwndTab: HWND); safecall;
+    procedure SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND); safecall;
+    procedure SetTabActive(hwndTab: HWND; hwndMDI: HWND; tbatFlags: DWORD); safecall;
+    procedure ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; Button: THUMBBUTTONLIST); safecall;
+    procedure ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; pButton: THUMBBUTTONLIST); safecall;
+    procedure ThumbBarSetImageList(hwnd: HWND; himl: HIMAGELIST); safecall;
+    procedure SetOverlayIcon(hwnd: HWND; hIcon: HICON; pszDescription: LPCWSTR); safecall;
+    procedure SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR); safecall;
+    procedure SetThumbnailClip(hwnd: HWND; prcClip: PRect); safecall;
+  end;
+
+const
+  DWM_SIT_DISPLAYFRAME 		= $00000001; // Display a window frame around the provided bitmap
+  DWMWA_FORCE_ICONIC_REPRESENTATION = 7;	// [set] Force this window to display iconic thumbnails.
+  DWMWA_HAS_ICONIC_BITMAP			= 10;	// [set] Indicates an available bitmap when there is no better thumbnail representation.
+  DWMWA_DISALLOW_PEEK				= 11;	// [set] Don't invoke Peek on the window.
+
+type
+  TWMDwmSendIconicLivePreviewBitmap = TWMNoParams;
+
+  TWMDwmSendIconicThumbnail = packed record
+    Msg
+      : Cardinal;
+    Unused
+      : Integer;
+    Height
+    , Width
+      : Word;
+    Result
+      : LongInt;
+  end;
+
+function DwmInvalidateIconicBitmaps(hwnd: HWND): HRESULT;
+function DwmSetIconicLivePreviewBitmap(hwnd: HWND; hbmp: HBITMAP; pptClient: PPoint; dwSITFlags: DWORD): HRESULT;
+function DwmSetIconicThumbnail(hWnd: HWND; hBmp: HBITMAP; dwSITFlags: DWORD): HRESULT;
+function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT;
+
+function PrintWindow(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL;
+
+implementation
+
+var
+  hDWMAPI: HMODULE;
+  _DwmInvalidateIconicBitmaps: function(hwnd: HWND): HRESULT; stdcall;
+  _DwmSetIconicThumbnail: function(hWnd: HWND; hBmp: HBITMAP; dwSITFlags: DWORD): HRESULT; stdcall;
+  _DwmSetIconicLivePreviewBitmap: function(hwnd: HWND; hbmp: HBITMAP; pptClient: PPoint; dwSITFlags: DWORD): HRESULT; stdcall;
+  _DwmSetWindowAttribute: function(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT; stdcall;
+  _PrintWindow: function(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL; stdcall;
+
+procedure InitDwmApi;
+begin
+  if hDWMAPI = 0 then
+  begin
+	  hDWMAPI := LoadLibrary('DWMAPI.DLL');
+  	if hDWMAPI = 0 then
+    begin
+      hDWMAPI := THandle(-1);
+    end
+  	else
+    begin
+      _DwmInvalidateIconicBitmaps := GetProcAddress(hDWMAPI, 'DwmInvalidateIconicBitmaps');
+      _DwmSetIconicLivePreviewBitmap := GetProcAddress(hDWMAPI, 'DwmSetIconicLivePreviewBitmap');
+      _DwmSetIconicThumbnail := GetProcAddress(hDWMAPI, 'DwmSetIconicThumbnail');
+      _DwmSetWindowAttribute := GetProcAddress(hDWMAPI, 'DwmSetWindowAttribute');
+		end;
+	end;
+end;
+
+function DwmInvalidateIconicBitmaps(hwnd: HWND): HRESULT;
+begin
+  InitDwmApi;
+  if Assigned(_DwmInvalidateIconicBitmaps) then
+    Result := _DwmInvalidateIconicBitmaps(hwnd)
+  else
+    Result := E_NOTIMPL;
+end;
+
+function DwmSetIconicLivePreviewBitmap(hwnd: HWND; hbmp: HBITMAP; pptClient: PPoint; dwSITFlags: DWORD): HRESULT;
+begin
+  InitDwmApi;
+  if Assigned(_DwmSetIconicLivePreviewBitmap) then
+    Result := _DwmSetIconicLivePreviewBitmap(hwnd, hbmp, pptClient, dwSITFlags)
+  else
+    Result := E_NOTIMPL;
+end;
+
+function DwmSetIconicThumbnail(hWnd: HWND; hBmp: HBITMAP; dwSITFlags: DWORD): HRESULT;
+begin
+  InitDwmApi;
+  if Assigned(_DwmSetIconicThumbnail) then
+    Result := _DwmSetIconicThumbnail(hWnd, hBmp, dwSITFlags)
+  else
+    Result := E_NOTIMPL;
+end;
+
+function DwmSetWindowAttribute(hwnd: HWND; dwAttribute: DWORD; pvAttribute: Pointer; cbAttribute: DWORD): HRESULT;
+begin
+  InitDwmApi;
+  if Assigned(_DwmSetWindowAttribute) then
+    Result := _DwmSetWindowAttribute(hwnd, dwAttribute, pvAttribute, cbAttribute)
+  else
+    Result := E_NOTIMPL;
+end;
+
+{-----------------------------------------------}
+
+function PrintWindow(hwnd: HWND; hdcBlt: HDC; nFlags: UINT): BOOL;
+begin
+  if Assigned(_PrintWindow) then
+  begin
+    Result := _PrintWindow(hwnd, hdcBlt, nFlags);
+  end
+  else
+  begin
+  	_PrintWindow := GetProcAddress(GetModuleHandle('user32.dll'), 'PrintWindow');
+	  Result := Assigned(_PrintWindow) and _PrintWindow(hwnd, hdcBlt, nFlags);
+	end;
+end;
+
+end.

KASToolBar/kasbarfiles.pas

@@ -0,0 +1,328 @@
+{
+   File name: kasbarfiles.pas
+
+   Author:    Dmitry Kolomiets (B4rr4cuda@rambler.ru)
+   Class working with *.bar files.
+
+   Based on KASToolBar functions
+   Copyright (C) 2006-2007  Koblov Alexander (Alexx2000@mail.ru)
+    
+   contributors:
+
+
+
+   This program is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2 of the
+   License, or (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   in a file called COPYING along with this program; if not, write to
+   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+   02139, USA.
+}
+
+unit KASBarFiles;
+
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,IniFiles;
+
+type
+
+  //Button property's type
+  //------------------------------------------------------
+    TInfor=(ButtonX,
+            CmdX,
+            ParamX,
+            PathX,
+            MenuX,
+            IconicX,
+            MiskX
+           );
+  //------------------------------------------------------
+
+ //Class of button
+ //---------------------------------
+ TKButton=class
+          ButtonX:string; //Icon
+          CmdX:string;    //Command or path
+          ParamX:string;  //parameters
+          PathX:string;
+          MenuX:string;   //Description
+          IconicX:Integer; //-1 0 1 full default minimized ( as TC use)
+          MiskX:string; //Aditional info (shortCut or extention or something else)
+         end;
+ //---------------------------------
+
+ { TBarClass }
+
+ TBarClass=class
+             CurrentBar:string;
+             
+           private
+             XButtons:Tlist;
+             FEnvVar : String;
+             FChangePath : String;
+             function GetButton(Index: Integer): TKButton;
+             function GetButtonCount: Integer;
+             function GetCmdDirFromEnvVar(sPath: String): String;
+             function SetCmdDirAsEnvVar(sPath: String): String;
+             procedure SetButton(Index:Integer; const AValue: TKButton);
+           //------------------------------------------------------
+
+           public
+
+             Constructor Create;
+             destructor Destroy; override;
+             //---------------------
+             function GetButtonX(Index:integer; What:TInfor):string;
+             function InsertButtonX(InsertAt: Integer; ButtonX, CmdX, ParamX, PathX, MenuX, MiskX: String): Integer;
+             function AddButtonX(ButtonX, CmdX, ParamX, PathX, MenuX, MiskX: String): Integer;
+             //---------------------
+             procedure RemoveButton(Index: Integer);
+             procedure DeleteAllButtons;
+             procedure SetButtonX(Index:integer; What:Tinfor;Value: string);
+             procedure LoadFromIniFile(IniFile : TIniFile);
+             procedure SaveToIniFile(IniFile : TIniFile);
+             procedure LoadFromFile(FileName : String);
+             procedure LoadFromStringList(List:TStringList);
+             procedure SaveToFile(FileName : String);
+             //---------------------
+             property ButtonCount: Integer read GetButtonCount;
+             property Buttons[Index:Integer]: TKButton read GetButton write SetButton;
+             property EnvVar : String read FEnvVar write FEnvVar;
+             property ChangePath : String read FChangePath write FChangePath;
+           //------------------------------------------------------
+           end;
+           
+implementation
+{ TBarClass }
+
+constructor TBarClass.Create;
+begin
+  XButtons:=TList.Create;
+end;
+
+destructor TBarClass.Destroy;
+var i:integer;
+begin
+    if Assigned(XButtons) then
+    begin
+      if XButtons.Count>0 then
+        for I := 0 to XButtons.Count - 1 do
+          TKButton(XButtons.Items[I]).Free;
+      FreeAndNil(XButtons);
+    end;
+
+  inherited Destroy;
+end;
+
+procedure TBarClass.SetButtonX(Index: integer; What: Tinfor; Value: string);
+begin
+If Index>=XButtons.Count then XButtons.Add(TKButton.Create);
+
+ case What of
+  ButtonX: TKButton(XButtons.Items[Index]).ButtonX:=Value;
+  cmdX:    TKButton(XButtons.Items[Index]).cmdX:=Value;
+  paramX:  TKButton(XButtons.Items[Index]).paramX:=Value;
+  pathX:   TKButton(XButtons.Items[Index]).pathX:=Value;
+  MenuX:   TKButton(XButtons.Items[Index]).menuX:=Value;
+  iconicX: begin
+             if Value='' then
+               TKButton(XButtons.Items[Index]).iconicX:=0
+             else
+               TKButton(XButtons.Items[Index]).iconicX:=StrToInt(Value);
+           end;
+  MiskX:   TKButton(XButtons.Items[Index]).MiskX:=Value;
+ end;
+
+end;
+
+procedure TBarClass.LoadFromIniFile(IniFile: TIniFile);
+var
+  BtnCount, I : Integer;
+begin
+  BtnCount := IniFile.ReadInteger('Buttonbar', 'Buttoncount', 0);
+  CurrentBar:= IniFile.FileName;
+  for I := 1 to BtnCount do
+    begin
+       XButtons.Add(TKButton.Create);
+           TKButton(XButtons[I-1]).ButtonX :=IniFile.ReadString('Buttonbar', 'button' + IntToStr(I), '');
+           TKButton(XButtons[I-1]).CmdX := IniFile.ReadString('Buttonbar', 'cmd' + IntToStr(I), '');
+           TKButton(XButtons[I-1]).ParamX := IniFile.ReadString('Buttonbar', 'param' + IntToStr(I), '');
+           TKButton(XButtons[I-1]).PathX := IniFile.ReadString('Buttonbar', 'path' + IntToStr(I), '');
+           TKButton(XButtons[I-1]).MenuX := IniFile.ReadString('Buttonbar', 'menu' + IntToStr(I), '');
+           TKButton(XButtons[I-1]).IconicX := IniFile.ReadInteger('Buttonbar', 'icon' + IntToStr(I),0);
+           TKButton(XButtons[I-1]).MiskX := IniFile.ReadString('Buttonbar', 'misk' + IntToStr(I), '');
+    end;
+end;
+
+procedure TBarClass.SaveToIniFile(IniFile: TIniFile);
+var
+  I : Integer;
+begin
+  //For cleaning. Without this saved file will contain removed buttons
+  IniFile.EraseSection('Buttonbar');
+  IniFile.WriteInteger('Buttonbar', 'Buttoncount', XButtons.Count);
+
+  for I := 0 to XButtons.Count - 1 do
+    begin
+      IniFile.WriteString('Buttonbar', 'button' + IntToStr(I + 1), SetCmdDirAsEnvVar(GetButtonX(I,ButtonX)));
+      IniFile.WriteString('Buttonbar', 'cmd' + IntToStr(I + 1), SetCmdDirAsEnvVar(GetButtonX(I,CmdX)));
+      IniFile.WriteString('Buttonbar', 'param' + IntToStr(I + 1), GetButtonX(I,ParamX) );
+      IniFile.WriteString('Buttonbar', 'path' + IntToStr(I + 1), GetButtonX(I,PathX) );
+      IniFile.WriteString('Buttonbar', 'menu' + IntToStr(I + 1),GetButtonX(I,MenuX) );
+      IniFile.WriteString('Buttonbar', 'misk' + IntToStr(I + 1),GetButtonX(I,MiskX) );
+    end;
+end;
+
+function TBarClass.GetButtonX(Index: integer; What: TInfor): string;
+begin
+if (index>=XButtons.Count) or (Index<0) then Exit;
+      case What of
+         ButtonX: Result := TKButton(XButtons.Items[Index]).ButtonX;
+         cmdX:    Result := TKButton(XButtons.Items[Index]).CmdX;
+         paramX:  Result := TKButton(XButtons.Items[Index]).ParamX;
+         pathX:   Result := TKButton(XButtons.Items[Index]).PathX;
+         menuX:   Result := TKButton(XButtons.Items[Index]).MenuX;
+         iconicX: Result := IntToStr(TKButton(XButtons.Items[Index]).IconicX);
+         MiskX:   Result := TKButton(XButtons.Items[Index]).MiskX;
+      end;
+end;
+
+function TBarClass.InsertButtonX(InsertAt: Integer; ButtonX, CmdX, ParamX, PathX, MenuX, MiskX: String): Integer;
+begin
+  if InsertAt < 0 then
+    InsertAt:= 0;
+  if InsertAt > XButtons.Count then
+    InsertAt:= XButtons.Count;
+
+  XButtons.Insert(InsertAt, TKButton.Create);
+
+  TKButton(XButtons[InsertAt]).CmdX:= CmdX;
+  TKButton(XButtons[InsertAt]).ButtonX:= ButtonX;
+  TKButton(XButtons[InsertAt]).ParamX:= ParamX;
+  TKButton(XButtons[InsertAt]).PathX:= PathX;
+  TKButton(XButtons[InsertAt]).MenuX:= MenuX;
+  TKButton(XButtons[InsertAt]).MiskX:= MiskX;
+
+  Result:= InsertAt;
+end;
+
+function TBarClass.AddButtonX(ButtonX, CmdX, ParamX, PathX, MenuX, MiskX: String): Integer;
+begin
+  Result := InsertButtonX(XButtons.Count, ButtonX, CmdX, ParamX, PathX, MenuX, MiskX);
+end;
+
+procedure TBarClass.LoadFromFile(FileName: String);
+var
+  IniFile : Tinifile;
+begin
+  DeleteAllButtons;
+  IniFile := Tinifile.Create(FileName);
+  LoadFromIniFile(IniFile);
+  IniFile.Free;
+end;
+
+
+procedure TBarClass.LoadFromStringList(List: TStringList);
+
+function ItemOfList(Item:string):string;
+begin
+if (List.IndexOfName(Item)>0) then
+  Result:=List.ValueFromIndex[List.IndexOfName(Item)]
+else
+  Result:='';
+end;
+
+var   BtnCount, I : Integer;
+begin
+  DeleteAllButtons;
+  if (List.IndexOfName('Buttoncount')<>0) then exit;
+   BtnCount:=StrToInt(List.ValueFromIndex[List.IndexOfName('Buttoncount')]);
+   
+   CurrentBar:='Virtual';
+  for I := 1 to BtnCount do
+    begin
+       XButtons.Add(TKButton.Create);
+           TKButton(XButtons[I-1]).ButtonX :=ItemOfList('button' + IntToStr(I));
+           TKButton(XButtons[I-1]).CmdX := ItemOfList('cmd' + IntToStr(I));
+           TKButton(XButtons[I-1]).ParamX :=ItemOfList('param' + IntToStr(I));
+           TKButton(XButtons[I-1]).PathX := ItemOfList('path' + IntToStr(I));
+           TKButton(XButtons[I-1]).MenuX := ItemOfList('menu' + IntToStr(I));
+           if (ItemOfList('icon' + IntToStr(I))<>'') then
+           TKButton(XButtons[I-1]).IconicX := StrToInt(ItemOfList('icon' + IntToStr(I)));
+           TKButton(XButtons[I-1]).MiskX := ItemOfList('misk' + IntToStr(I));
+    end;
+
+end;
+
+procedure TBarClass.SaveToFile(FileName: String);
+var
+  IniFile : Tinifile;
+begin
+  IniFile := Tinifile.Create(FileName);
+  SaveToIniFile(IniFile);
+  IniFile.Free;
+end;
+
+procedure TBarClass.RemoveButton(Index: Integer);
+begin
+    TKButton(XButtons[Index]).Free;
+    XButtons.Delete(Index);
+end;
+
+procedure TBarClass.DeleteAllButtons;
+begin
+    while XButtons.Count>0 do
+      begin
+        TKButton(XButtons[0]).Free;
+        XButtons.Delete(0);
+      end;
+end;
+
+function TBarClass.GetButtonCount: Integer;
+begin
+Result := XButtons.Count;
+end;
+
+function TBarClass.GetButton(Index:Integer): TKButton;
+begin
+  Result:=TKButton(XButtons[Index]);
+end;
+
+function TBarClass.GetCmdDirFromEnvVar(sPath: String): String;
+begin
+  DoDirSeparators(sPath);
+  if Pos(FEnvVar, sPath) <> 0 then
+    Result := StringReplace(sPath, FEnvVar, ExcludeTrailingPathDelimiter(FChangePath), [rfIgnoreCase])
+  else
+    Result := sPath;
+end;
+
+procedure TBarClass.SetButton(Index:Integer; const AValue: TKButton);
+begin
+ XButtons[Index]:=AValue;
+end;
+
+function TBarClass.SetCmdDirAsEnvVar(sPath: String): String;
+begin
+  DoDirSeparators(sPath);
+  if Pos(FChangePath, sPath) <> 0 then
+    Result := StringReplace(sPath, ExcludeTrailingPathDelimiter(FChangePath), FEnvVar, [rfIgnoreCase])
+  else
+    Result := sPath;
+end;
+
+end.
+

KASToolBar/kasbarmenu.pas

@@ -0,0 +1,203 @@
+{
+   File name: kasbarmenu.pas
+
+   KASBarMenu  Copyright (C) 2008  Dmitry Kolomiets (B4rr4cuda@rambler.ru)
+   Popup menu with *.bar's buttons as MenuItems
+
+   Based on KASToolBar functions
+   Copyright (C) 2006-2007  Koblov Alexander (Alexx2000@mail.ru)
+
+
+   contributors:
+
+   This program is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2 of the
+   License, or (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   in a file called COPYING along with this program; if not, write to
+   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+   02139, USA.
+}
+
+
+unit KASBarMenu;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  Menus, KASBarFiles, FileUtil, IniFiles;
+  
+type
+
+TOnLoadButtonGlyph   = function (sIconFileName : String; iIconSize : Integer; clBackColor : TColor) : TBitmap of object;
+TOnMenuButtonClick = procedure (Sender: TObject; NumberOfButton : Integer) of object;
+
+  { TKASBarMenu }
+
+  TKASBarMenu = class(TPopupMenu)
+  private
+   FBar:TBarClass;
+   FOnLoadButtonGlyph : TOnLoadButtonGlyph;
+   FOnMenuButtonClick : TOnMenuButtonClick;
+
+  //------------------------------------------------------
+   procedure MenuOnClick(Sender: TObject);
+   function LoadBtnIcon(IconPath: String): TBitMap;
+  //------------------------------------------------------
+
+  protected
+  public
+   constructor Create(TheOwner: TComponent); override;
+   destructor Destroy; override;
+   //---------------------
+
+   procedure Clear;
+   procedure LoadFromStringList(List: TStringList);
+   procedure LoadFromIniFile(IniFile : TIniFile);
+   procedure SaveToIniFile(IniFile : TIniFile);
+   procedure LoadBarFile(FileName:string);
+   procedure SaveToFile(FileName : String);
+   
+   procedure MakeMenu;
+  //------------------------------------------------------
+
+  published
+    property BarFile: TBarClass read FBar write FBar;
+    property OnLoadButtonGlyph : TOnLoadButtonGlyph read FOnLoadButtonGlyph write FOnLoadButtonGlyph;
+    property OnMenuButtonClick: TOnMenuButtonClick read FOnMenuButtonClick write FOnMenuButtonClick;
+  //------------------------------------------------------
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('KASComponents',[TKASBarMenu]);
+end;
+
+{ TKASBarMenu }
+
+function TKASBarMenu.LoadBtnIcon(IconPath: String): TBitMap;
+var
+  PNG : TPortableNetworkGraphic;
+begin
+  Result := Graphics.TBitmap.Create;
+  if (IconPath <> '') and FileExists(IconPath) then
+   begin
+     if CompareFileExt(IconPath, 'png', false) = 0 then
+        begin
+          PNG := TPortableNetworkGraphic.Create;
+          try
+            PNG.LoadFromFile(IconPath);
+            Result.Assign(PNG);
+          finally
+            FreeAndNil(PNG);
+          end;
+        end
+     else
+        begin
+          Result.LoadFromFile(IconPath);
+        end;
+   end;
+end;
+
+procedure TKASBarMenu.MenuOnClick(Sender: TObject);
+begin
+  if Assigned(FOnMenuButtonClick) then
+     FOnMenuButtonClick(Self, (Sender as TMenuItem).Tag);
+end;
+
+constructor TKASBarMenu.Create(TheOwner: TComponent);
+begin
+  FBar:=TBarClass.Create;
+  inherited Create(TheOwner);
+end;
+
+destructor TKASBarMenu.Destroy;
+begin
+  FBar.DeleteAllButtons;
+  FreeAndNil(FBar);
+  inherited Destroy;
+end;
+
+procedure TKASBarMenu.Clear;
+begin
+  FBar.DeleteAllButtons;
+end;
+
+procedure TKASBarMenu.MakeMenu;
+var
+  I:Integer;
+  Item:TMenuItem;
+  BitmapTmp: TBitmap;
+begin
+  For I:=0 to Fbar.ButtonCount-1 do
+    begin
+      Item:=TMenuItem.Create(Self);
+      if Fbar.GetButtonX(I,MiskX) <> '' then
+         Item.Caption:=Fbar.GetButtonX(I,MenuX)+' ('+Fbar.GetButtonX(I,MiskX)+')'
+      else
+         Item.Caption:=Fbar.GetButtonX(I,MenuX);
+      //------------------------------------------------------
+      if Assigned(FOnLoadButtonGlyph) then
+        BitmapTmp := FOnLoadButtonGlyph(FBar.GetButtonX(I,ButtonX), 16, clMenu)
+      else
+        BitmapTmp := LoadBtnIcon(FBar.GetButtonX(I,ButtonX));
+
+      Item.Bitmap := BitmapTmp;
+      if Assigned(BitmapTmp) then
+        FreeAndNil(BitmapTmp);
+      //------------------------------------------------------
+      Item.Tag:=I;
+      Item.OnClick:=TNotifyEvent(@MenuOnClick);
+      Self.Items.Insert(I,Item);
+    end;
+end;
+
+procedure TKASBarMenu.LoadBarFile(FileName: string);
+begin
+  FBar.DeleteAllButtons;
+  Self.Items.Clear;
+  FBar.LoadFromFile(FileName);
+  MakeMenu;
+end;
+
+procedure TKASBarMenu.LoadFromStringList(List: TStringList);
+begin
+  FBar.DeleteAllButtons;
+  Self.Items.Clear;
+  FBar.LoadFromStringList(List);
+  MakeMenu;
+end;
+
+procedure TKASBarMenu.LoadFromIniFile(IniFile: TIniFile);
+begin
+  FBar.DeleteAllButtons;
+  Self.Items.Clear;
+  FBar.LoadFromIniFile(IniFile);
+  MakeMenu;
+end;
+
+procedure TKASBarMenu.SaveToIniFile(IniFile: TIniFile);
+begin
+  FBar.SaveToIniFile(IniFile);
+end;
+
+procedure TKASBarMenu.SaveToFile(FileName: String);
+begin
+  FBar.SaveToFile(FileName);
+end;
+
+end.

KASToolBar/kascombobox.pas

@@ -0,0 +1,76 @@
+{
+   Double Commander Components
+   -------------------------------------------------------------------------
+   Extended ComboBox classes
+
+   Copyright (C) 2012  Przemyslaw Nagay (cobines@gmail.com)
+
+   This program is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2 of the
+   License, or (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   in a file called COPYING along with this program; if not, write to
+   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+   02139, USA.
+}
+
+unit KASComboBox;
+
+{$mode objfpc}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
+
+type
+
+  { TComboBoxWithDelItems }
+
+  {en
+     Combo box that allows removing items with Shift+Delete.
+  }
+  TComboBoxWithDelItems = class(TComboBox)
+  protected
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+  end;
+
+procedure Register;
+
+implementation
+
+uses
+  LCLType;
+
+procedure Register;
+begin
+  RegisterComponents('KASComponents',[TComboBoxWithDelItems]);
+end;
+
+{ TComboBoxWithDelItems }
+
+procedure TComboBoxWithDelItems.KeyDown(var Key: Word; Shift: TShiftState);
+var
+  Index: Integer;
+begin
+  if DroppedDown and (Key = VK_DELETE) and (Shift = [ssShift]) then
+  begin
+    Index := ItemIndex;
+    if (Index >= 0) and (Index < Items.Count) then
+    begin
+      Items.Delete(Index);
+      ItemIndex := Index;
+      Key := 0;
+    end;
+  end;
+  inherited KeyDown(Key, Shift);
+end;
+
+end.

KASToolBar/kascomp.lpk

@@ -0,0 +1,81 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="4">
+    <Name Value="KASComp"/>
+    <AddToProjectUsesSection Value="True"/>
+    <Author Value="Alexander Koblov"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Parsing>
+        <SyntaxOptions>
+          <SyntaxMode Value="Delphi"/>
+        </SyntaxOptions>
+      </Parsing>
+      <Linking>
+        <Debugging>
+          <DebugInfoType Value="dsDwarf2Set"/>
+        </Debugging>
+      </Linking>
+      <Other>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Description Value="ToolBar that loading from *.ini file. Format of *.ini file 
+      KASBarMenu is popupmenu read *.bar file and uses *.bar buttons as menu items.
+"/>
+    <License Value="GNU GPL 2
+"/>
+    <Version Major="1" Minor="8"/>
+    <Files Count="5">
+      <Item1>
+        <Filename Value="kastoolbar.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="KASToolBar"/>
+      </Item1>
+      <Item2>
+        <Filename Value="kasprogressbar.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="KASProgressBar"/>
+      </Item2>
+      <Item3>
+        <Filename Value="kaspathedit.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="KASPathEdit"/>
+      </Item3>
+      <Item4>
+        <Filename Value="kastoolitems.pas"/>
+        <UnitName Value="KASToolItems"/>
+      </Item4>
+      <Item5>
+        <Filename Value="kascombobox.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="KASComboBox"/>
+      </Item5>
+    </Files>
+    <Type Value="RunAndDesignTime"/>
+    <RequiredPkgs Count="3">
+      <Item1>
+        <PackageName Value="doublecmd_common"/>
+        <MinVersion Minor="3" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="FCL"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item3>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

KASToolBar/kascomp.pas

@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit KASComp;
+
+interface
+
+uses
+  KASToolBar, KASProgressBar, KASPathEdit, KASToolItems, 
+  KASComboBox, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+  RegisterUnit('KASToolBar', @KASToolBar.Register);
+  RegisterUnit('KASProgressBar', @KASProgressBar.Register);
+  RegisterUnit('KASPathEdit', @KASPathEdit.Register);
+  RegisterUnit('KASComboBox', @KASComboBox.Register);
+end;
+
+initialization
+  RegisterPackage('KASComp', @Register);
+end.

KASToolBar/kaspathedit.pas

@@ -0,0 +1,317 @@
+{
+   Double Commander Components
+   -------------------------------------------------------------------------
+   Path edit class with auto complete feature
+
+   Copyright (C) 2012-2014  Alexander Koblov (alexx2000@mail.ru)
+
+   This program is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2 of the
+   License, or (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   in a file called COPYING along with this program; if not, write to
+   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+   02139, USA.
+}
+
+unit KASPathEdit;
+
+{$mode delphi}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ShellCtrls, LCLType;
+
+type
+
+  { TKASPathEdit }
+
+  TKASPathEdit = class(TEdit)
+  private
+    FPanel: THintWindow;
+    FListBox: TListBox;
+    FKeyDown: Word;
+    FAutoComplete: Boolean;
+    FObjectTypes: TObjectTypes;
+    FFileSortType: TFileSortType;
+  private
+    procedure AutoComplete(const Path: UTF8String);
+    procedure SetObjectTypes(const AValue: TObjectTypes);
+    procedure FormChangeBoundsEvent(Sender: TObject);
+    procedure ListBoxClick(Sender: TObject);
+    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+  private
+    procedure ShowListBox;
+    procedure HideListBox;
+  protected
+{$IF DEFINED(LCLWIN32)}
+    procedure CreateWnd; override;
+{$ENDIF}
+    procedure DoExit; override;
+    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+    procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes;
+    property FileSortType: TFileSortType read FFileSortType write FFileSortType;
+  end;
+
+procedure Register;
+
+implementation
+
+uses
+  LCLProc, Math
+  {$IF DEFINED(LCLWIN32)}
+  , ComObj
+  {$ENDIF}
+  ;
+
+{$IF DEFINED(LCLWIN32)}
+
+const
+  SHACF_AUTOAPPEND_FORCE_ON  = $40000000;
+  SHACF_AUTOSUGGEST_FORCE_ON = $10000000;
+  SHACF_FILESYS_ONLY         = $00000010;
+  SHACF_FILESYS_DIRS         = $00000020;
+
+function SHAutoComplete(hwndEdit: HWND; dwFlags: DWORD): HRESULT; stdcall; external 'shlwapi.dll';
+
+function SHAutoCompleteX(hwndEdit: HWND; ObjectTypes: TObjectTypes): Boolean;
+var
+  dwFlags: DWORD;
+begin
+  if (ObjectTypes = []) then Exit(False);
+  dwFlags := SHACF_AUTOAPPEND_FORCE_ON or SHACF_AUTOSUGGEST_FORCE_ON;
+  if (otNonFolders in ObjectTypes) then
+    dwFlags := dwFlags or SHACF_FILESYS_ONLY
+  else if (otFolders in ObjectTypes) then
+    dwFlags := dwFlags or SHACF_FILESYS_DIRS;
+  Result:= (SHAutoComplete(hwndEdit, dwFlags) = 0);
+end;
+
+{$ENDIF}
+
+procedure Register;
+begin
+  RegisterComponents('KASComponents', [TKASPathEdit]);
+end;
+
+{ TKASPathEdit }
+
+procedure TKASPathEdit.AutoComplete(const Path: UTF8String);
+var
+  I: LongWord;
+  BasePath: UTF8String;
+begin
+  FListBox.Clear;
+  if Pos(PathDelim, Path) > 0 then
+  begin
+    BasePath:= ExtractFilePath(Path);
+    TCustomShellTreeView.GetFilesInDir(
+                                       BasePath,
+                                       ExtractFileName(Path) + '*',
+                                       FObjectTypes,
+                                       FListBox.Items,
+                                       FFileSortType
+                                       );
+    if (FListBox.Items.Count > 0) then
+    begin
+      ShowListBox;
+      // Make absolute file name
+      for I:= 0 to FListBox.Items.Count - 1 do
+      FListBox.Items[I]:= BasePath + FListBox.Items[I];
+      // Calculate ListBox height
+      with FListBox.ItemRect(0) do
+      I:= Bottom - Top; // TListBox.ItemHeight sometimes don't work under GTK2
+      with FListBox do
+      begin
+        if Items.Count = 1 then
+          FPanel.ClientHeight:= Self.Height
+        else
+          FPanel.ClientHeight:= I * IfThen(Items.Count > 10, 11, Items.Count + 1);
+      end;
+    end;
+  end;
+  if (FListBox.Items.Count = 0) then HideListBox;
+end;
+
+procedure TKASPathEdit.SetObjectTypes(const AValue: TObjectTypes);
+begin
+  if FObjectTypes = AValue then Exit;
+  FObjectTypes:= AValue;
+{$IF DEFINED(LCLWIN32)}
+  if HandleAllocated then RecreateWnd(Self);
+  if FAutoComplete then
+{$ENDIF}
+  FAutoComplete:= (FObjectTypes <> []);
+end;
+
+procedure TKASPathEdit.FormChangeBoundsEvent(Sender: TObject);
+begin
+  HideListBox;
+end;
+
+procedure TKASPathEdit.ListBoxClick(Sender: TObject);
+begin
+  if FListBox.ItemIndex >= 0 then
+  begin
+    Text:= FListBox.Items[FListBox.ItemIndex];
+    SelStart:= UTF8Length(Text);
+    HideListBox;
+    SetFocus;
+  end;
+end;
+
+procedure TKASPathEdit.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+begin
+  FListBox.ItemIndex:= FListBox.ItemAtPos(Classes.Point(X, Y), True);
+end;
+
+procedure TKASPathEdit.ShowListBox;
+begin
+  if (FPanel = nil) then
+  begin
+    FPanel:= THintWindow.Create(Self);
+    FPanel.Color:= clForm;
+    FListBox.Parent:= FPanel;
+
+    with Parent.ClientToScreen(CLasses.Point(Left, Top)) do
+    begin
+      FPanel.Left:= X;
+      FPanel.Top:= Y + Height;
+    end;
+
+    FPanel.Width:= Width;
+    FPanel.Visible:= True;
+
+    Application.AddOnDeactivateHandler(FormChangeBoundsEvent, True);
+    GetParentForm(Self).AddHandlerOnChangeBounds(FormChangeBoundsEvent, True);
+  end;
+end;
+
+procedure TKASPathEdit.HideListBox;
+begin
+  if (FPanel <> nil) then
+  begin
+    FPanel.Visible:= False;
+    FListBox.Parent:= nil;
+    FreeAndNil(FPanel);
+    Application.RemoveOnDeactivateHandler(FormChangeBoundsEvent);
+    GetParentForm(Self).RemoveHandlerOnChangeBounds(FormChangeBoundsEvent);
+  end;
+end;
+
+{$IF DEFINED(LCLWIN32)}
+
+procedure TKASPathEdit.CreateWnd;
+begin
+  inherited CreateWnd;
+  FAutoComplete:= not SHAutoCompleteX(Handle, FObjectTypes);
+end;
+
+{$ENDIF}
+
+procedure TKASPathEdit.DoExit;
+begin
+  HideListBox;
+  inherited DoExit;
+end;
+
+procedure TKASPathEdit.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+  FKeyDown:= Key;
+  case Key of
+    VK_ESCAPE,
+    VK_RETURN,
+    VK_SELECT:
+      begin
+        HideListBox;
+      end;
+    VK_UP:
+      if Assigned(FPanel) then
+      begin
+        Key:= 0;
+        if FListBox.ItemIndex = -1 then
+          FListBox.ItemIndex:= FListBox.Items.Count - 1
+        else if FListBox.ItemIndex - 1 < 0 then
+          FListBox.ItemIndex:= - 1
+        else
+          FListBox.ItemIndex:= FListBox.ItemIndex - 1;
+
+        if FListBox.ItemIndex >= 0 then
+          Text:= FListBox.Items[FListBox.ItemIndex]
+        else
+          Text:= ExtractFilePath(Text);
+        SelStart:= UTF8Length(Text);
+      end;
+    VK_DOWN:
+      if Assigned(FPanel) then
+      begin
+        Key:= 0;
+        if FListBox.ItemIndex + 1 >= FListBox.Items.Count then
+          FListBox.ItemIndex:= -1
+        else if FListBox.ItemIndex = -1 then
+          FListBox.ItemIndex:= IfThen(FListBox.Items.Count > 0, 0, -1)
+        else
+          FListBox.ItemIndex:= FListBox.ItemIndex + 1;
+
+        if FListBox.ItemIndex >= 0 then
+          Text:= FListBox.Items[FListBox.ItemIndex]
+        else
+          Text:= ExtractFilePath(Text);
+        SelStart:= UTF8Length(Text);
+      end;
+  end;
+  inherited KeyDown(Key, Shift);
+{$IFDEF LCLGTK2}
+  // Workaround for GTK2 - up and down arrows moving through controls.
+  if Key in [VK_UP, VK_DOWN] then Key:= 0;
+{$ENDIF}
+end;
+
+procedure TKASPathEdit.KeyUpAfterInterface(var Key: Word; Shift: TShiftState);
+begin
+  if (FKeyDown = Key) and FAutoComplete and not (Key in [VK_ESCAPE, VK_RETURN, VK_SELECT, VK_UP, VK_DOWN]) then
+  begin
+    if Modified then
+    begin
+      Modified:= False;
+      AutoComplete(Text);
+    end;
+  end;
+  inherited KeyUpAfterInterface(Key, Shift);
+{$IF DEFINED(LCLWIN32)}
+  // Windows auto-completer eats the TAB so LCL doesn't get it and doesn't move to next control.
+  if not FAutoComplete and (Key = VK_TAB) then
+    GetParentForm(Self).SelectNext(Self, True, True);
+{$ENDIF}
+end;
+
+constructor TKASPathEdit.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  FListBox:= TListBox.Create(Self);
+  FListBox.TabStop:= False;
+  FListBox.Align:= alClient;
+  FListBox.ClickOnSelChange:= False;
+  FListBox.OnClick:= ListBoxClick;
+  FListBox.OnMouseMove:= ListBoxMouseMove;
+
+  FAutoComplete:= True;
+  FFileSortType:= fstFoldersFirst;
+  FObjectTypes:= [otNonFolders, otFolders];
+end;
+
+end.

KASToolBar/kasprogressbar.pas

@@ -0,0 +1,184 @@
+{
+   Double Commander Components
+   -------------------------------------------------------------------------
+   Extended ProgressBar class
+
+   Copyright (C) 2010  Przemyslaw Nagay (cobines@gmail.com)
+   Copyright (C) 2011-2012  Koblov Alexander (Alexx2000@mail.ru)
+
+   Windows 7 implementation based on "Windows 7 Component Library"
+   by Daniel Wischnewski (http://www.gumpi.com/blog)
+
+   This program is free software; you can redistribute it and/or
+   modify it under the terms of the GNU General Public License as
+   published by the Free Software Foundation; either version 2 of the
+   License, or (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   in a file called COPYING along with this program; if not, write to
+   the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+   02139, USA.
+}
+
+unit KASProgressBar;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LCLType, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls
+  {$IFDEF LCLWIN32}
+  , InterfaceBase, ComObj, dwTaskbarList
+  {$ENDIF}
+  {$IFDEF LCLGTK2}
+  , Gtk2
+  {$ENDIF}
+  {$IFDEF LCLQT}
+  , qt4, qtwidgets
+  {$ENDIF}
+  ;
+
+type
+
+  { TKASProgressBar }
+
+  TKASProgressBar = class(TProgressBar)
+  private
+    FShowInTaskbar: Boolean;
+    {$IFDEF LCLWIN32}
+    FTaskBarEntryHandle: HWND;
+    FTaskbarList: ITaskbarList;
+    FTaskbarList3: ITaskbarList3;
+    {$ENDIF}
+  protected
+    {$IFDEF LCLWIN32}
+    procedure InitializeWnd; override;
+    {$ENDIF}
+    procedure DoOnResize; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+
+    procedure SetProgress(CurrentValue: Int64; MaxValue: Int64; BarText: String = '');
+  published
+    property ShowInTaskbar: Boolean read FShowInTaskbar write FShowInTaskbar default False;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('KASComponents',[TKASProgressBar]);
+end;
+
+{ TKASProgressBar }
+
+{$IFDEF LCLWIN32}
+procedure TKASProgressBar.InitializeWnd;
+var
+  aOwnerForm: TWinControl;
+begin
+  inherited InitializeWnd;
+  if CheckWin32Version(6, 1) then
+  begin
+    aOwnerForm:= GetParentForm(Self);
+    if Assigned(aOwnerForm) and (aOwnerForm <> Application.MainForm) then
+      FTaskBarEntryHandle := aOwnerForm.Handle
+    else
+      FTaskBarEntryHandle := Widgetset.AppHandle;
+  end;
+end;
+{$ENDIF}
+
+procedure TKASProgressBar.DoOnResize;
+begin
+  inherited;
+  Max := Width;
+end;
+
+constructor TKASProgressBar.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+  {$IFDEF LCLWIN32}
+  FTaskbarList3 := nil;
+  FTaskBarEntryHandle := INVALID_HANDLE_VALUE;
+  // Works only under Windows 7 and higher
+  if CheckWin32Version(6, 1) then
+  try
+    FTaskbarList := ITaskbarList(CreateComObject(CLSID_TaskbarList));
+    FTaskbarList.HrInit;
+    FTaskbarList.QueryInterface(CLSID_TaskbarList3, FTaskbarList3);
+  except
+    FTaskbarList3 := nil;
+  end;
+  {$ENDIF}
+
+  {$IFDEF LCLGTK2}
+  // Have to disable LCLGTK2 default progress bar text
+  // set in TGtk2WSProgressBar.UpdateProgressBarText.
+  BarShowText := False;
+  {$ENDIF}
+end;
+
+procedure TKASProgressBar.SetProgress(CurrentValue: Int64; MaxValue: Int64;
+  BarText: String);
+{$IFDEF LCLGTK2}
+var
+  wText: String;
+{$ENDIF}
+{$IFDEF LCLQT}
+var
+  wText: WideString;
+{$ENDIF}
+begin
+  if MaxValue <> 0 then
+    Position := Round(CurrentValue * Max / MaxValue)
+  else
+    Position := 0;
+
+{$IFDEF LCLWIN32}
+  if FShowInTaskbar and (FTaskBarEntryHandle <> INVALID_HANDLE_VALUE) and Assigned(FTaskbarList3) then
+  begin
+    FTaskbarList3.SetProgressValue(FTaskBarEntryHandle, Position, Max);
+  end;
+{$ENDIF}
+
+{$IFDEF LCLGTK2}
+{
+  %v - the current progress value.
+  %l - the lower bound for the progress value.
+  %u - the upper bound for the progress value.
+  %p - the current progress percentage.
+}
+  if BarText <> '' then
+    wText := BarText + ' (%p%%)'
+  else
+    wText := '%p%%';
+  gtk_progress_set_format_string(PGtkProgress(Self.Handle), PChar(wText));
+  // Have to reset 'show_text' every time because LCLGTK2 will set it according to BarShowText.
+  gtk_progress_set_show_text(PGtkProgress(Self.Handle), True);
+{$ENDIF}
+{$IFDEF LCLQT}
+{
+  %p - is replaced by the percentage completed.
+  %v - is replaced by the current value.
+  %m - is replaced by the total number of steps.
+}
+  if BarText <> '' then
+    wText := WideString(BarText) + ' (%p%)'
+  else
+    wText := '%p%';
+  QProgressBar_setFormat(QProgressBarH(TQtProgressBar(Self.Handle).Widget), @wText);
+  //QProgressBar_setTextVisible(QProgressBarH(TQtProgressBar(Self.Handle).Widget), True);
+{$ENDIF}
+end;
+
+end.

KASToolBar/kastoolitems.pas

@@ -0,0 +1,589 @@
+{
+    Double Commander
+    -------------------------------------------------------------------------
+    Basic tool items types for KASToolBar
+
+    Copyright (C) 2012  Przemyslaw Nagay (cobines@gmail.com)
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+}
+
+unit KASToolItems;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DCXmlConfig, DCBasicTypes;
+
+type
+  TKASToolBarItems = class;
+  TKASToolItem = class;
+
+  TOnLoadToolItem = procedure (Item: TKASToolItem) of object;
+
+  {$interfaces corba}
+  IToolOwner = interface
+    ['{A7908D38-1E13-4E8D-8FA7-8830A2FF9290}']
+    function ExecuteToolItem(Item: TKASToolItem): Boolean;
+    function GetToolItemShortcutsHint(Item: TKASToolItem): String;
+  end;
+  {$interfaces default}
+
+  { TKASToolBarLoader }
+
+  TKASToolBarLoader = class
+  protected
+    function CreateItem(Node: TXmlNode): TKASToolItem; virtual;
+  public
+    procedure Load(Config: TXmlConfig; RootNode: TXmlNode; OnLoadToolItem: TOnLoadToolItem); virtual;
+  end;
+
+  { TKASToolItem }
+
+  TKASToolItem = class
+  private
+    FToolOwner: IToolOwner;
+    FUserData: Pointer;
+  protected
+    property ToolOwner: IToolOwner read FToolOwner;
+  public
+    procedure Assign(OtherItem: TKASToolItem); virtual;
+    function CheckExecute(ToolItemID: String): Boolean; virtual;
+    function Clone: TKASToolItem; virtual; abstract;
+    function ConfigNodeName: String; virtual; abstract;
+    function GetEffectiveHint: String; virtual; abstract;
+    function GetEffectiveText: String; virtual; abstract;
+    procedure Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader); virtual; abstract;
+    procedure Save(Config: TXmlConfig; Node: TXmlNode);
+    procedure SaveContents(Config: TXmlConfig; Node: TXmlNode); virtual; abstract;
+    procedure SetToolOwner(AToolOwner: IToolOwner); virtual;
+    property UserData: Pointer read FUserData write FUserData;
+  end;
+  TKASToolItemClass = class of TKASToolItem;
+
+  { TKASSeparatorItem }
+
+  TKASSeparatorItem = class(TKASToolItem)
+    procedure Assign(OtherItem: TKASToolItem); override;
+    function Clone: TKASToolItem; override;
+    function ConfigNodeName: String; override;
+    function GetEffectiveHint: String; override;
+    function GetEffectiveText: String; override;
+    procedure Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader); override;
+    procedure SaveContents(Config: TXmlConfig; Node: TXmlNode); override;
+  end;
+
+  { TKASNormalItem }
+
+  TKASNormalItem = class(TKASToolItem)
+  strict private
+    FID: String;            // Unique identificator of the button
+    function GetID: String;
+  strict protected
+    procedure SaveHint(Config: TXmlConfig; Node: TXmlNode); virtual;
+    procedure SaveIcon(Config: TXmlConfig; Node: TXmlNode); virtual;
+    procedure SaveText(Config: TXmlConfig; Node: TXmlNode); virtual;
+  public
+    Icon: String;
+    Text: String;
+    Hint: String;
+    procedure Assign(OtherItem: TKASToolItem); override;
+    function CheckExecute(ToolItemID: String): Boolean; override;
+    function Clone: TKASToolItem; override;
+    function ConfigNodeName: String; override;
+    function GetEffectiveHint: String; override;
+    function GetEffectiveText: String; override;
+    function GetShortcutsHint: String;
+    procedure Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader); override;
+    procedure SaveContents(Config: TXmlConfig; Node: TXmlNode); override;
+    property ID: String read GetID;
+  end;
+
+  { TKASMenuItem }
+
+  TKASMenuItem = class(TKASNormalItem)
+    procedure ToolItemLoaded(Item: TKASToolItem);
+  private
+    FItems: TKASToolBarItems;
+  public
+    constructor Create; reintroduce;
+    destructor Destroy; override;
+    procedure Assign(OtherItem: TKASToolItem); override;
+    function CheckExecute(ToolItemID: String): Boolean; override;
+    function Clone: TKASToolItem; override;
+    function ConfigNodeName: String; override;
+    procedure Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader); override;
+    procedure SaveContents(Config: TXmlConfig; Node: TXmlNode); override;
+    procedure SetToolOwner(AToolOwner: IToolOwner); override;
+    property SubItems: TKASToolBarItems read FItems;
+  end;
+
+  { TKASToolBarItems }
+
+  TKASToolBarItems = class
+  private
+    FButtons: TFPList;
+    function GetButton(Index: Integer): TKASToolItem;
+    function GetButtonCount: Integer;
+    procedure SetButton(Index: Integer; const AValue: TKASToolItem);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function Add(Item: TKASToolItem): Integer;
+    procedure Clear;
+    function Insert(InsertAt: Integer; Item: TKASToolItem): Integer;
+    procedure Move(FromIndex, ToIndex: Integer);
+    {en
+       Returns the item at Index, removes it from the list but does not free it like Remove.
+    }
+    function ReleaseItem(Index: Integer): TKASToolItem;
+    procedure Remove(Index: Integer);
+    property Count: Integer read GetButtonCount;
+    property Items[Index: Integer]: TKASToolItem read GetButton write SetButton; default;
+  end;
+
+  { TKASToolBarSerializer }
+
+  TKASToolBarSerializer = class
+  private
+    FDeserializedItem: TKASToolItem;
+    procedure SetDeserializedItem(Item: TKASToolItem);
+  public
+    function Deserialize(Stream: TStream; Loader: TKASToolBarLoader): TKASToolItem;
+    procedure Serialize(Stream: TStream; Item: TKASToolItem);
+  end;
+
+const
+  MenuItemConfigNode = 'Menu';
+  NormalItemConfigNode = 'Normal';
+  SeparatorItemConfigNode = 'Separator';
+
+implementation
+
+uses
+  DCStrUtils;
+
+{ TKASToolItem }
+
+procedure TKASToolItem.Assign(OtherItem: TKASToolItem);
+begin
+  FUserData := OtherItem.FUserData;
+end;
+
+function TKASToolItem.CheckExecute(ToolItemID: String): Boolean;
+begin
+  Result := False;
+end;
+
+procedure TKASToolItem.Save(Config: TXmlConfig; Node: TXmlNode);
+begin
+  Node := Config.AddNode(Node, ConfigNodeName);
+  SaveContents(Config, Node);
+end;
+
+procedure TKASToolItem.SetToolOwner(AToolOwner: IToolOwner);
+begin
+  FToolOwner := AToolOwner;
+end;
+
+{ TKASToolBarSerializer }
+
+function TKASToolBarSerializer.Deserialize(Stream: TStream; Loader: TKASToolBarLoader): TKASToolItem;
+var
+  Config: TXmlConfig;
+begin
+  Result := nil;
+  FDeserializedItem := nil;
+  Config := TXmlConfig.Create;
+  try
+    Config.ReadFromStream(Stream);
+    Loader.Load(Config, Config.RootNode, @SetDeserializedItem);
+    Result := FDeserializedItem;
+  finally
+    Config.Free;
+  end;
+end;
+
+procedure TKASToolBarSerializer.Serialize(Stream: TStream; Item: TKASToolItem);
+var
+  Config: TXmlConfig;
+begin
+  Config := TXmlConfig.Create;
+  try
+    Item.Save(Config, Config.RootNode);
+    Config.WriteToStream(Stream);
+  finally
+    Config.Free;
+  end;
+end;
+
+procedure TKASToolBarSerializer.SetDeserializedItem(Item: TKASToolItem);
+begin
+  FDeserializedItem := Item;
+end;
+
+{ TKASToolBarLoader }
+
+function TKASToolBarLoader.CreateItem(Node: TXmlNode): TKASToolItem;
+begin
+  if Node.CompareName(MenuItemConfigNode) = 0 then
+    Result := TKASMenuItem.Create
+  else if Node.CompareName(NormalItemConfigNode) = 0 then
+    Result := TKASNormalItem.Create
+  else if Node.CompareName(SeparatorItemConfigNode) = 0 then
+    Result := TKASSeparatorItem.Create
+  else
+    Result := nil;
+end;
+
+procedure TKASToolBarLoader.Load(Config: TXmlConfig; RootNode: TXmlNode; OnLoadToolItem: TOnLoadToolItem);
+var
+  Node: TXmlNode;
+  Item: TKASToolItem;
+begin
+  Node := RootNode.FirstChild;
+  while Assigned(Node) do
+  begin
+    Item := CreateItem(Node);
+
+    if Assigned(Item) then
+      try
+        Item.Load(Config, Node, Self);
+        OnLoadToolItem(Item);
+        Item := nil;
+      finally
+        FreeAndNil(Item);
+      end;
+
+    Node := Node.NextSibling;
+  end;
+end;
+
+{ TKASMenuItem }
+
+procedure TKASMenuItem.Assign(OtherItem: TKASToolItem);
+var
+  MenuItem: TKASMenuItem;
+  Item: TKASToolItem;
+  I: Integer;
+begin
+  inherited Assign(OtherItem);
+  if OtherItem is TKASMenuItem then
+  begin
+    MenuItem := TKASMenuItem(OtherItem);
+    FItems.Clear;
+    for I := 0 to MenuItem.SubItems.Count - 1 do
+    begin
+      Item := MenuItem.SubItems.Items[I].Clone;
+      Item.SetToolOwner(ToolOwner);
+      FItems.Add(Item);
+    end;
+  end;
+end;
+
+function TKASMenuItem.CheckExecute(ToolItemID: String): Boolean;
+var
+  I: Integer;
+begin
+  Result := inherited CheckExecute(ToolItemID);
+  if not Result then
+  begin
+    for I := 0 to SubItems.Count - 1 do
+    begin
+      if SubItems[I].CheckExecute(ToolItemID) then
+        Exit(True);
+    end;
+  end;
+end;
+
+function TKASMenuItem.Clone: TKASToolItem;
+begin
+  Result := TKASMenuItem.Create;
+  Result.Assign(Self);
+end;
+
+function TKASMenuItem.ConfigNodeName: String;
+begin
+  Result := MenuItemConfigNode;
+end;
+
+constructor TKASMenuItem.Create;
+begin
+  FItems := TKASToolBarItems.Create;
+end;
+
+destructor TKASMenuItem.Destroy;
+begin
+  inherited Destroy;
+  FItems.Free;
+end;
+
+procedure TKASMenuItem.Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader);
+begin
+  inherited Load(Config, Node, Loader);
+  SubItems.Clear;
+  Node := Config.FindNode(Node, 'MenuItems', False);
+  if Assigned(Node) then
+    Loader.Load(Config, Node, @ToolItemLoaded);
+end;
+
+procedure TKASMenuItem.SaveContents(Config: TXmlConfig; Node: TXmlNode);
+var
+  I: Integer;
+begin
+  inherited SaveContents(Config, Node);
+  if SubItems.Count > 0 then
+  begin
+    Node := Config.AddNode(Node, 'MenuItems');
+    for I := 0 to SubItems.Count - 1 do
+      SubItems.Items[I].Save(Config, Node);
+  end;
+end;
+
+procedure TKASMenuItem.SetToolOwner(AToolOwner: IToolOwner);
+var
+  I: Integer;
+begin
+  inherited SetToolOwner(AToolOwner);
+  for I := 0 to SubItems.Count - 1 do
+    SubItems.Items[I].SetToolOwner(ToolOwner);
+end;
+
+procedure TKASMenuItem.ToolItemLoaded(Item: TKASToolItem);
+begin
+  Item.SetToolOwner(ToolOwner);
+  SubItems.Add(Item);
+end;
+
+{ TKASDividerItem }
+
+procedure TKASSeparatorItem.Assign(OtherItem: TKASToolItem);
+begin
+  inherited Assign(OtherItem);
+end;
+
+function TKASSeparatorItem.Clone: TKASToolItem;
+begin
+  Result := TKASSeparatorItem.Create;
+  Result.Assign(Self);
+end;
+
+function TKASSeparatorItem.ConfigNodeName: String;
+begin
+  Result := SeparatorItemConfigNode;
+end;
+
+function TKASSeparatorItem.GetEffectiveHint: String;
+begin
+  Result := '';
+end;
+
+function TKASSeparatorItem.GetEffectiveText: String;
+begin
+  Result := '';
+end;
+
+procedure TKASSeparatorItem.Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader);
+begin
+  // Empty.
+end;
+
+procedure TKASSeparatorItem.SaveContents(Config: TXmlConfig; Node: TXmlNode);
+begin
+  // Empty.
+end;
+
+{ TKASNormalItem }
+
+procedure TKASNormalItem.Assign(OtherItem: TKASToolItem);
+var
+  NormalItem: TKASNormalItem;
+begin
+  inherited Assign(OtherItem);
+  if OtherItem is TKASNormalItem then
+  begin
+    // Don't copy ID.
+    NormalItem     := TKASNormalItem(OtherItem);
+    Icon           := NormalItem.Icon;
+    Text           := NormalItem.Text;
+    Hint           := NormalItem.Hint;
+  end;
+end;
+
+function TKASNormalItem.CheckExecute(ToolItemID: String): Boolean;
+begin
+  Result := (ID = ToolItemID);
+  if Result and Assigned(FToolOwner) then
+    FToolOwner.ExecuteToolItem(Self);
+end;
+
+function TKASNormalItem.Clone: TKASToolItem;
+begin
+  Result := TKASNormalItem.Create;
+  Result.Assign(Self);
+end;
+
+function TKASNormalItem.ConfigNodeName: String;
+begin
+  Result := NormalItemConfigNode;
+end;
+
+function TKASNormalItem.GetEffectiveHint: String;
+var
+  ShortcutsHint: String;
+begin
+  Result := Hint;
+  ShortcutsHint := GetShortcutsHint;
+  if ShortcutsHint <> '' then
+    AddStrWithSep(Result, '(' + ShortcutsHint + ')', ' ');
+end;
+
+function TKASNormalItem.GetEffectiveText: String;
+begin
+  Result := Text;
+end;
+
+function TKASNormalItem.GetID: String;
+var
+  Guid: TGuid;
+begin
+  if FID = EmptyStr then
+  begin
+    if CreateGUID(Guid) = 0 then
+      FID := GUIDToString(Guid)
+    else
+      FID := IntToStr(Random(MaxInt));
+  end;
+  Result := FID;
+end;
+
+function TKASNormalItem.GetShortcutsHint: String;
+begin
+  if Assigned(FToolOwner) then
+    Result := FToolOwner.GetToolItemShortcutsHint(Self)
+  else
+    Result := '';
+end;
+
+procedure TKASNormalItem.Load(Config: TXmlConfig; Node: TXmlNode; Loader: TKASToolBarLoader);
+begin
+  Node := Node.FirstChild;
+  while Assigned(Node) do
+  begin
+    if Node.CompareName('ID') = 0 then
+      FID     := Config.GetContent(Node)
+    else if Node.CompareName('Text') = 0 then
+      Text    := Config.GetContent(Node)
+    else if Node.CompareName('Icon') = 0 then
+      Icon    := Config.GetContent(Node)
+    else if Node.CompareName('Hint') = 0 then
+      Hint := Config.GetContent(Node);
+    Node := Node.NextSibling;
+  end;
+end;
+
+procedure TKASNormalItem.SaveContents(Config: TXmlConfig; Node: TXmlNode);
+begin
+  Config.AddValue(Node, 'ID', ID);
+  SaveText(Config, Node);
+  SaveIcon(Config, Node);
+  SaveHint(Config, Node);
+end;
+
+procedure TKASNormalItem.SaveHint(Config: TXmlConfig; Node: TXmlNode);
+begin
+  Config.AddValueDef(Node, 'Hint', Hint, '');
+end;
+
+procedure TKASNormalItem.SaveIcon(Config: TXmlConfig; Node: TXmlNode);
+begin
+  Config.AddValueDef(Node, 'Icon', Icon, '');
+end;
+
+procedure TKASNormalItem.SaveText(Config: TXmlConfig; Node: TXmlNode);
+begin
+  Config.AddValueDef(Node, 'Text', Text, '');
+end;
+
+{ TKASToolBarItems }
+
+constructor TKASToolBarItems.Create;
+begin
+  FButtons := TFPList.Create;
+end;
+
+destructor TKASToolBarItems.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+  FButtons.Free;
+end;
+
+function TKASToolBarItems.Insert(InsertAt: Integer; Item: TKASToolItem): Integer;
+begin
+  FButtons.Insert(InsertAt, Item);
+  Result := InsertAt;
+end;
+
+procedure TKASToolBarItems.Move(FromIndex, ToIndex: Integer);
+begin
+  FButtons.Move(FromIndex, ToIndex);
+end;
+
+function TKASToolBarItems.ReleaseItem(Index: Integer): TKASToolItem;
+begin
+  Result := TKASToolItem(FButtons[Index]);
+  FButtons.Delete(Index);
+end;
+
+function TKASToolBarItems.Add(Item: TKASToolItem): Integer;
+begin
+  Result := FButtons.Add(Item);
+end;
+
+procedure TKASToolBarItems.Remove(Index: Integer);
+begin
+  TKASToolItem(FButtons[Index]).Free;
+  FButtons.Delete(Index);
+end;
+
+procedure TKASToolBarItems.Clear;
+var
+  i: Integer;
+begin
+  for i := 0 to FButtons.Count - 1 do
+    TKASToolItem(FButtons[i]).Free;
+  FButtons.Clear;
+end;
+
+function TKASToolBarItems.GetButtonCount: Integer;
+begin
+  Result := FButtons.Count;
+end;
+
+function TKASToolBarItems.GetButton(Index: Integer): TKASToolItem;
+begin
+  Result := TKASToolItem(FButtons[Index]);
+end;
+
+procedure TKASToolBarItems.SetButton(Index: Integer; const AValue: TKASToolItem);
+begin
+  TKASToolItem(FButtons[Index]).Free;
+  FButtons[Index] := AValue;
+end;
+
+end.