mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

UPD: ToolBar configuration dialog

Browse source
This commit is contained in:
Alexander Koblov 2007-11-23 23:10:40 +00:00
commit 6142fdaffd
19 changed files with 5737 additions and 5875 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/uOSForms.txt
View file

@ -4,4 +4,5 @@
17.07.2007 ADD: Добавил обработку команд открыть, вставить, переименовать,
удалить в контекстное меню
15.08.2007 ADD: Обновление списка дисков
19.08.2007 ADD: Функции отображения файла в память
19.08.2007 ADD: Функции отображения файла в память
23.11.2007 ADD: Функцию ShowOpenIconDialog, которая открывает диалог выбора значка

3
doc/ucopythread.txt
View file

@ -1,3 +1,4 @@
$$$*** This is unit history file ***$$$ ###encoding="UTF-8"###
25.07.2007 DEL: Перенес функцию CorrectFileInfo (теперь FileCopyAttr) в модуль uOSUtils
30.09.2007 Добавил проверку свободного места перед и во время копирования (баг [1741043] копирование)
30.09.2007 Добавил проверку свободного места перед и во время копирования (баг [1741043] копирование)
23.11.2007 Исправил ошибку при копировании занятого файла

3
doc/upixmapmanager.txt
View file

@ -6,4 +6,5 @@
10.08.2007 Сделал более корректное отображение иконок в VFS ( еще раз :) )
06.11.2007 Добавил функцию GetDriveIcon
Сделал отображение иконок в дисковой панели
с поддержкой прозрачности под Windows
с поддержкой прозрачности под Windows
23.11.2007 Добавил функции StretchBitmap и LoadBitmapFromFile

127
doublecmd.lpi
View file

@ -20,10 +20,7 @@
</i18n>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="\mnt\X\linux\sccmd\scfpc\"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<UseExcludeFileFilter Value="True"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
@ -52,238 +49,230 @@
<PackageName Value="JPEGForLazarus"/>
</Item5>
</RequiredPackages>
<Units Count="30">
<Units Count="29">
<Unit0>
<Filename Value="doublecmd.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="doublecmd"/>
</Unit0>
<Unit1>
<Filename Value="fbtnchangedlg.pas"/>
<ComponentName Value="frmOneButtonChangeDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fbtnchangedlg.lrs"/>
<UnitName Value="fbtnchangedlg"/>
</Unit1>
<Unit2>
<Filename Value="fconfigtoolbar.pas"/>
<ComponentName Value="frmButtonChangeDlg"/>
<ComponentName Value="frmConfigToolBar"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fconfigtoolbar.lrs"/>
<UnitName Value="fconfigtoolbar"/>
</Unit2>
<Unit3>
<UnitName Value="fConfigToolBar"/>
</Unit1>
<Unit2>
<Filename Value="fmain.pas"/>
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fmain.lrs"/>
<UnitName Value="fMain"/>
</Unit3>
<Unit4>
</Unit2>
<Unit3>
<Filename Value="uwcxprototypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uWCXprototypes"/>
</Unit4>
<Unit5>
</Unit3>
<Unit4>
<Filename Value="fviewer.pas"/>
<ComponentName Value="frmViewer"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fviewer.lrs"/>
<UnitName Value="fViewer"/>
</Unit5>
<Unit6>
</Unit4>
<Unit5>
<Filename Value="feditor.pas"/>
<ComponentName Value="frmEditor"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="feditor.lrs"/>
<UnitName Value="fEditor"/>
</Unit6>
<Unit7>
</Unit5>
<Unit6>
<Filename Value="fMsg.pas"/>
<ComponentName Value="frmMsg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fMsg.lrs"/>
<UnitName Value="fMsg"/>
</Unit7>
<Unit8>
</Unit6>
<Unit7>
<Filename Value="dmdialogs.pas"/>
<ComponentName Value="dmDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="dmdialogs.lrs"/>
<UnitName Value="dmDialogs"/>
</Unit8>
<Unit9>
</Unit7>
<Unit8>
<Filename Value="dmhigh.pas"/>
<ComponentName Value="dmHighl"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="dmhigh.lrs"/>
<UnitName Value="dmHigh"/>
</Unit9>
<Unit10>
</Unit8>
<Unit9>
<Filename Value="feditorconf.pas"/>
<ComponentName Value="frmEditorConf"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="feditorconf.lrs"/>
<UnitName Value="fEditorConf"/>
</Unit10>
<Unit11>
</Unit9>
<Unit10>
<Filename Value="ffindview.pas"/>
<ComponentName Value="frmFindView"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="ffindview.lrs"/>
<UnitName Value="fFindView"/>
</Unit11>
<Unit12>
</Unit10>
<Unit11>
<Filename Value="fAbout.pas"/>
<ComponentName Value="frmAbout"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fAbout.lrs"/>
<UnitName Value="fAbout"/>
</Unit12>
<Unit13>
</Unit11>
<Unit12>
<Filename Value="foptions.pas"/>
<ComponentName Value="frmOptions"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="foptions.lrs"/>
<UnitName Value="fOptions"/>
</Unit13>
<Unit14>
</Unit12>
<Unit13>
<Filename Value="fFileOpDlg.pas"/>
<ComponentName Value="frmFileOp"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fFileOpDlg.lrs"/>
<UnitName Value="fFileOpDlg"/>
</Unit14>
<Unit15>
</Unit13>
<Unit14>
<Filename Value="fmkdir.pas"/>
<ComponentName Value="frmMkDir"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fmkdir.lrs"/>
<UnitName Value="fMkDir"/>
</Unit15>
<Unit16>
</Unit14>
<Unit15>
<Filename Value="fCopyDlg.pas"/>
<ComponentName Value="frmCopyDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fCopyDlg.lrs"/>
<UnitName Value="fCopyDlg"/>
</Unit16>
<Unit17>
</Unit15>
<Unit16>
<Filename Value="fcomparefiles.pas"/>
<ComponentName Value="frmCompareFiles"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fcomparefiles.lrs"/>
<UnitName Value="fCompareFiles"/>
</Unit17>
<Unit18>
</Unit16>
<Unit17>
<Filename Value="fmovedlg.pas"/>
<ComponentName Value="frmMoveDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fmovedlg.lrs"/>
<UnitName Value="fMoveDlg"/>
</Unit18>
<Unit19>
</Unit17>
<Unit18>
<Filename Value="fFindDlg.pas"/>
<ComponentName Value="frmFindDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fFindDlg.lrs"/>
<UnitName Value="fFindDlg"/>
</Unit19>
<Unit20>
</Unit18>
<Unit19>
<Filename Value="fhotdir.pas"/>
<ComponentName Value="frmHotDir"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fhotdir.lrs"/>
<UnitName Value="fHotDir"/>
</Unit20>
<Unit21>
</Unit19>
<Unit20>
<Filename Value="fsymlink.pas"/>
<ComponentName Value="frmSymLink"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fsymlink.lrs"/>
<UnitName Value="fSymLink"/>
</Unit21>
<Unit22>
</Unit20>
<Unit21>
<Filename Value="fhardlink.pas"/>
<ComponentName Value="frmHardLink"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fhardlink.lrs"/>
<UnitName Value="fHardLink"/>
</Unit22>
<Unit23>
</Unit21>
<Unit22>
<Filename Value="fmultirename.pas"/>
<ComponentName Value="frmMultiRename"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fmultirename.lrs"/>
<UnitName Value="fMultiRename"/>
</Unit23>
<Unit24>
</Unit22>
<Unit23>
<Filename Value="fpackdlg.pas"/>
<ComponentName Value="frmPackDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fpackdlg.lrs"/>
<UnitName Value="fPackDlg"/>
</Unit24>
<Unit25>
</Unit23>
<Unit24>
<Filename Value="flinker.pas"/>
<ComponentName Value="frmLinker"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="flinker.lrs"/>
<UnitName Value="fLinker"/>
</Unit25>
<Unit26>
</Unit24>
<Unit25>
<Filename Value="fsplitter.pas"/>
<ComponentName Value="frmSplitter"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fsplitter.lrs"/>
<UnitName Value="fSplitter"/>
</Unit26>
<Unit27>
</Unit25>
<Unit26>
<Filename Value="ffileproperties.pas"/>
<ComponentName Value="frmFileProperties"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="ffileproperties.lrs"/>
<UnitName Value="fFileProperties"/>
</Unit27>
<Unit28>
</Unit26>
<Unit27>
<Filename Value="fextractdlg.pas"/>
<ComponentName Value="frmExtractDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceFilename Value="fextractdlg.lrs"/>
<UnitName Value="fExtractDlg"/>
</Unit28>
<Unit29>
</Unit27>
<Unit28>
<Filename Value="ulng.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uLng"/>
</Unit29>
</Unit28>
</Units>
</ProjectOptions>
<CompilerOptions>

196
doublecmd.lpr
View file

@ -1,98 +1,98 @@
{ $threading on}
program doublecmd;
// uGlobs must be first in uses, uLng must be before any form;
{%File 'doc/changelog.txt'}
{.$APPTYPE GUI}
uses
{$IFDEF UNIX}
cthreads,
//cwstring,
{$ENDIF}
Interfaces,
LCLProc,
uGlobsPaths,
uGlobs,
uLng,
SysUtils,
Forms,
fMain,
fAbout,
uFileList,
uFilePanel,
uFileOp,
uTypes,
framePanel,
uFileOpThread,
uFileProcs,
fFileOpDlg,
uCopyThread,
uDeleteThread,
fMkDir,
uCompareFiles,
uHighlighterProcs,
fEditor,
uMoveThread,
fMsg,
uSpaceThread,
fHotDir,
fHardLink,
fFindView,
uPathHistory,
uExts,
uLog,
uShowForm,
fEditSearch,
uColorExt,
fEditorConf,
{$IFNDEF WIN32}
uFindMmap,
fFileProperties,
uUsersGroups,
{$ENDIF}
fLinker,
fCompareFiles,
dmHigh,
uPixMapManager, uVFS,
KASComp, fbtnchangedlg, fconfigtoolbar, uWCXprototypes, uDCUtils,
dmDialogs, fViewer, fOptions, fCopyDlg, fMoveDlg, fFindDlg,
fSymLink, fMultiRename, fSplitter, fPackDlg, fExtractDlg;
{$IFDEF WIN32}
{$R XP.res}
{$ENDIF}
const
buildDate = {$I %DATE%};
begin
// AssignFile(output, 'c:\doublecmd.log');
// Rewrite(output);
Application.Title:='Double Commander';
// try
Application.Initialize;
ThousandSeparator:=' ';
DebugLn('Double commander 0.2 alpha - Free Pascal');
DebugLn('Build: ' + buildDate);
DebugLn('This program is free software released under terms of GNU GPL 2');
DebugLn('(C)opyright 2006-7 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn(' and contributors (see about dialog)');
fAbout.buildDate := buildDate;
LoadPaths;
if LoadGlobs then
begin
LoadPixMapManager;
Application.CreateForm(TfrmMain, frmMain); // main form
Application.CreateForm(TdmHighl, dmHighl); // highlighters
Application.CreateForm(TdmDlg, dmDlg); // dialogs
Application.Run;
end;
{ except
on E:Exception do
Writeln('Critical unhandled exception:', E.Message);
end}
end.
{ $threading on}
program doublecmd;
// uGlobs must be first in uses, uLng must be before any form;
{%File 'doc/changelog.txt'}
{.$APPTYPE GUI}
uses
{$IFDEF UNIX}
cthreads,
//cwstring,
{$ENDIF}
Interfaces,
LCLProc,
uGlobsPaths,
uGlobs,
uLng,
SysUtils,
Forms,
fMain,
fAbout,
uFileList,
uFilePanel,
uFileOp,
uTypes,
framePanel,
uFileOpThread,
uFileProcs,
fFileOpDlg,
uCopyThread,
uDeleteThread,
fMkDir,
uCompareFiles,
uHighlighterProcs,
fEditor,
uMoveThread,
fMsg,
uSpaceThread,
fHotDir,
fHardLink,
fFindView,
uPathHistory,
uExts,
uLog,
uShowForm,
fEditSearch,
uColorExt,
fEditorConf,
{$IFNDEF WIN32}
uFindMmap,
fFileProperties,
uUsersGroups,
{$ENDIF}
fLinker,
fCompareFiles,
dmHigh,
uPixMapManager, uVFS,
KASComp, fconfigtoolbar, uWCXprototypes, uDCUtils,
dmDialogs, fViewer, fOptions, fCopyDlg, fMoveDlg, fFindDlg,
fSymLink, fMultiRename, fSplitter, fPackDlg, fExtractDlg;
{$IFDEF WIN32}
{$R XP.res}
{$ENDIF}
const
buildDate = {$I %DATE%};
begin
// AssignFile(output, 'c:\doublecmd.log');
// Rewrite(output);
Application.Title:='Double Commander';
// try
Application.Initialize;
ThousandSeparator:=' ';
DebugLn('Double commander 0.2 alpha - Free Pascal');
DebugLn('Build: ' + buildDate);
DebugLn('This program is free software released under terms of GNU GPL 2');
DebugLn('(C)opyright 2006-7 Koblov Alexander (Alexx2000@mail.ru)');
DebugLn(' and contributors (see about dialog)');
fAbout.buildDate := buildDate;
LoadPaths;
if LoadGlobs then
begin
LoadPixMapManager;
Application.CreateForm(TfrmMain, frmMain); // main form
Application.CreateForm(TdmHighl, dmHighl); // highlighters
Application.CreateForm(TdmDlg, dmDlg); // dialogs
Application.Run;
end;
{ except
on E:Exception do
Writeln('Critical unhandled exception:', E.Message);
end}
end.

228
fbtnchangedlg.lfm
View file

@ -1,228 +0,0 @@
object frmOneButtonChangeDlg: TfrmOneButtonChangeDlg
Tag = 1
Left = 213
Height = 240
Top = 186
Width = 550
HelpContext = 270
HorzScrollBar.Page = 549
VertScrollBar.Page = 239
ActiveControl = cbCommand
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Change single button'
ClientHeight = 240
ClientWidth = 550
Font.Color = clBtnText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Position = poScreenCenter
object lblCommand: TLabel
Left = 4
Height = 14
Top = 7
Width = 80
AutoSize = False
Caption = '&Command:'
FocusControl = cbCommand
ParentColor = False
end
object lblParameters: TLabel
Left = 4
Height = 14
Top = 35
Width = 92
AutoSize = False
Caption = '&Parameters:'
FocusControl = kedtParams
ParentColor = False
end
object lblStartpath: TLabel
Left = 4
Height = 14
Top = 60
Width = 80
AutoSize = False
Caption = '&Start path:'
FocusControl = kedtStartpath
ParentColor = False
end
object lblIconfile: TLabel
Left = 4
Height = 13
Top = 85
Width = 80
AutoSize = False
Caption = 'Icon &file:'
FocusControl = kedtIconFileName
ParentColor = False
end
object lblIconX: TLabel
Left = 4
Height = 14
Top = 110
Width = 45
AutoSize = False
Caption = '&Icon:'
FocusControl = lblIcons
ParentColor = False
WordWrap = True
end
object lblIconIndex: TLabel
Left = 54
Height = 14
Top = 110
Width = 25
AutoSize = False
Caption = '0'
ParentColor = False
WordWrap = True
end
object lblTooltip: TLabel
Left = 4
Height = 14
Top = 167
Width = 80
AutoSize = False
Caption = '&Tooltip:'
FocusControl = kedtToolTip
ParentColor = False
end
object cbCommand: TComboBox
Left = 104
Height = 21
Top = 6
Width = 298
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
DropDownCount = 20
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
TabOrder = 0
end
object btnOpenFile: TButton
Left = 403
Height = 22
Top = 5
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenFileClick
TabOrder = 1
end
object btnAddSubBar: TButton
Left = 431
Height = 22
Top = 5
Width = 118
BorderSpacing.InnerBorder = 4
Caption = 'Add Subbar >>'
TabOrder = 2
end
object kedtParams: TKASEdit
Left = 104
Height = 21
Top = 31
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 3
end
object kedtStartpath: TKASEdit
Left = 104
Height = 21
Top = 56
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 4
end
object kedtIconFileName: TKASEdit
Left = 104
Height = 21
Top = 81
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 5
end
object btnOpenIconFile: TButton
Left = 403
Height = 21
Top = 81
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenIconFileClick
TabOrder = 6
end
object lblIcons: TListBox
Left = 104
Height = 54
Top = 106
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 36
Style = lbOwnerDrawFixed
TabOrder = 7
end
object kedtToolTip: TKASEdit
Left = 104
Height = 21
Top = 164
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 8
end
object btnOK: TButton
Left = 443
Height = 32
Top = 104
Width = 100
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
OnClick = btnOKClick
TabOrder = 9
end
object btnCancel: TButton
AnchorSideTop.Control = btnOK
AnchorSideTop.Side = asrBottom
Left = 443
Height = 32
Top = 140
Width = 100
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
OnClick = btnCancelClick
TabOrder = 10
end
object btnHelp: TButton
AnchorSideTop.Control = btnCancel
AnchorSideTop.Side = asrBottom
Left = 443
Height = 32
Top = 176
Width = 100
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Caption = '&Help'
TabOrder = 11
end
object OpenDialog: TOpenDialog
Title = 'Îòêðûòü ñóùåñòâóþùèé ôàéë'
FilterIndex = 0
left = 32
top = 496
end
end

14
fbtnchangedlg.lrt
View file

@ -1,14 +0,0 @@
TFRMONEBUTTONCHANGEDLG.CAPTION=Change single button
TFRMONEBUTTONCHANGEDLG.LBLCOMMAND.CAPTION=&Command:
TFRMONEBUTTONCHANGEDLG.LBLPARAMETERS.CAPTION=&Parameters:
TFRMONEBUTTONCHANGEDLG.LBLSTARTPATH.CAPTION=&Start path:
TFRMONEBUTTONCHANGEDLG.LBLICONFILE.CAPTION=Icon &file:
TFRMONEBUTTONCHANGEDLG.LBLICONX.CAPTION=&Icon:
TFRMONEBUTTONCHANGEDLG.LBLICONINDEX.CAPTION=0
TFRMONEBUTTONCHANGEDLG.LBLTOOLTIP.CAPTION=&Tooltip:
TFRMONEBUTTONCHANGEDLG.BTNOPENFILE.CAPTION=>>
TFRMONEBUTTONCHANGEDLG.BTNADDSUBBAR.CAPTION=Add Subbar >>
TFRMONEBUTTONCHANGEDLG.BTNOPENICONFILE.CAPTION=>>
TFRMONEBUTTONCHANGEDLG.BTNOK.CAPTION=OK
TFRMONEBUTTONCHANGEDLG.BTNCANCEL.CAPTION=Cancel
TFRMONEBUTTONCHANGEDLG.BTNHELP.CAPTION=&Help

112
fbtnchangedlg.pas
View file

@ -1,112 +0,0 @@
{
Double Commander
----------------------------
Configuration Toolbar
Licence : GNU GPL v 2.0
Author : Alexander Koblov (Alexx2000@mail.ru)
contributors:
}
unit fbtnchangedlg;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, KASEdit;
type
{ TfrmOneButtonChangeDlg }
TfrmOneButtonChangeDlg = class(TForm)
btnCancel: TButton;
lblCommand: TLabel;
IconX: TLabel;
lblIconfile: TLabel;
cbCommand: TComboBox;
btnOpenFile: TButton;
btnAddSubBar: TButton;
lblIcons: TListBox;
btnOpenIconFile: TButton;
kedtIconFileName: TKASEdit;
lblIconIndex: TLabel;
kedtParams: TKASEdit;
kedtStartpath: TKASEdit;
kedtToolTip: TKASEdit;
btnHelp: TButton;
btnOK: TButton;
OpenDialog: TOpenDialog;
lblParameters: TLabel;
lblStartpath: TLabel;
lblTooltip: TLabel;
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnOpenFileClick(Sender: TObject);
procedure btnOpenIconFileClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
procedure ShowOneBtnChangeDlg(NumberOfButton : Integer);
var
frmOneButtonChangeDlg: TfrmOneButtonChangeDlg;
LastToolButton : Integer;
implementation
uses fMain, uGlobsPaths;
{ TfrmOneButtonChangeDlg }
procedure ShowOneBtnChangeDlg(NumberOfButton : Integer);
begin
with TfrmOneButtonChangeDlg.Create(Application) do
try
cbCommand.Text := frmMain.MainToolBar.Commands[NumberOfButton];
kedtIconFileName.Text := frmMain.MainToolBar.Icons[NumberOfButton];
kedtToolTip.Text := frmMain.MainToolBar.Buttons[NumberOfButton].Hint;
LastToolButton := NumberOfButton;
ShowModal;
finally
Free;
end;
end;
procedure TfrmOneButtonChangeDlg.btnCancelClick(Sender: TObject);
begin
Close;
end;
procedure TfrmOneButtonChangeDlg.btnOKClick(Sender: TObject);
begin
frmMain.MainToolBar.Commands[LastToolButton] := cbCommand.Text;
frmMain.MainToolBar.Icons[LastToolButton] := kedtIconFileName.Text;
frmMain.MainToolBar.Buttons[LastToolButton].Hint := kedtToolTip.Text;
frmMain.MainToolBar.SaveToFile(gpIniDir + 'default.bar');
Close;
end;
procedure TfrmOneButtonChangeDlg.btnOpenFileClick(Sender: TObject);
begin
if OpenDialog.Execute then
cbCommand.Text := OpenDialog.FileName;
end;
procedure TfrmOneButtonChangeDlg.btnOpenIconFileClick(Sender: TObject);
begin
if OpenDialog.Execute then
kedtIconFileName.Text := OpenDialog.FileName;
end;
initialization
{$I fbtnchangedlg.lrs}
end.

210
fconfigtoolbar.lfm
View file

@ -1,16 +1,16 @@
object frmButtonChangeDlg: TfrmButtonChangeDlg
Left = 252
Height = 304
Top = 537
object frmConfigToolBar: TfrmConfigToolBar
Left = 276
Height = 272
Top = 256
Width = 578
HelpContext = 270
HorzScrollBar.Page = 577
VertScrollBar.Page = 303
VertScrollBar.Page = 271
ActiveControl = btnOpenBarFile
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Change button bar'
ClientHeight = 304
ClientHeight = 272
ClientWidth = 578
Font.Color = clBtnText
Font.Height = -11
@ -20,139 +20,149 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
object lblButtonBar: TLabel
Left = 6
Height = 13
Top = 5
Top = 4
Width = 75
AutoSize = False
Caption = '&Button bar:'
ParentColor = False
end
object lblLabel: TLabel
Left = -5
Height = 2
Top = 80
Width = 562
AutoSize = False
Color = clWindowFrame
ParentColor = False
Transparent = False
end
object lblCommand: TLabel
Left = 4
Height = 13
Top = 87
Width = 81
AutoSize = False
Height = 14
Top = 98
Width = 52
Caption = '&Command:'
FocusControl = cbCommand
ParentColor = False
end
object lblLabel: TLabel
AnchorSideTop.Control = tbScrollBox
AnchorSideTop.Side = asrBottom
Left = -5
Height = 2
Top = 83
Width = 590
AutoSize = False
BorderSpacing.Top = 8
Color = clWindowFrame
ParentColor = False
Transparent = False
end
object lblParameters: TLabel
Left = 4
Height = 13
Top = 115
Width = 108
AutoSize = False
Height = 14
Top = 120
Width = 60
Caption = '&Parameters:'
FocusControl = kedtParams
ParentColor = False
end
object lblStartpath: TLabel
object lblStartPath: TLabel
Left = 4
Height = 13
Top = 140
Width = 81
AutoSize = False
Height = 14
Top = 147
Width = 54
Caption = '&Start path:'
FocusControl = kedtStartPath
ParentColor = False
end
object lblIconfile: TLabel
object lblIconFile: TLabel
Left = 4
Height = 13
Top = 165
Width = 81
AutoSize = False
Height = 14
Top = 171
Width = 43
Caption = 'Icon &file:'
FocusControl = kedtIconFileName
ParentColor = False
end
object lblIconX: TLabel
object lblIcon: TLabel
Left = 4
Height = 13
Top = 190
Width = 49
AutoSize = False
Height = 14
Top = 197
Width = 26
Caption = 'Ic&on:'
FocusControl = lbIcons
ParentColor = False
WordWrap = True
end
object lblIconIndex: TLabel
Left = 54
Height = 14
Top = 190
Width = 25
AutoSize = False
Caption = '0'
ParentColor = False
WordWrap = True
end
object lblTooltip: TLabel
object lblToolTip: TLabel
Left = 4
Height = 14
Top = 248
Width = 81
AutoSize = False
Top = 238
Width = 37
Caption = '&Tooltip:'
FocusControl = kedtToolTip
ParentColor = False
end
object sbIconExample: TSpeedButton
AnchorSideTop.Control = kedtIconFileName
AnchorSideTop.Side = asrBottom
Left = 120
Height = 38
Top = 194
Width = 38
BorderSpacing.Top = 6
Color = clBtnFace
NumGlyphs = 0
end
object btnOpenBarFile: TButton
Left = 427
AnchorSideLeft.Control = stToolBarFileName
AnchorSideLeft.Side = asrBottom
Left = 425
Height = 21
Top = 2
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenBarFileClick
TabOrder = 0
end
object btnDeleteButton: TButton
AnchorSideTop.Control = btnAddButton
AnchorSideTop.Side = asrBottom
Left = 4
Height = 23
Top = 52
Width = 77
BorderSpacing.Top = 6
BorderSpacing.InnerBorder = 4
Caption = '&Delete'
OnClick = btnDeleteButtonClick
TabOrder = 2
end
object btnAddButton: TButton
AnchorSideTop.Control = lblButtonBar
AnchorSideTop.Side = asrBottom
Left = 4
Height = 23
Top = 25
Top = 23
Width = 77
BorderSpacing.Top = 6
BorderSpacing.InnerBorder = 4
Caption = '&Append'
OnClick = btnAddButtonClick
TabOrder = 1
end
object cbCommand: TComboBox
AnchorSideTop.Control = lblLabel
AnchorSideTop.Side = asrBottom
Left = 120
Height = 21
Top = 86
Top = 91
Width = 298
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
BorderSpacing.Top = 6
DropDownCount = 20
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 13
MaxLength = 0
OnSelect = cbCommandSelect
TabOrder = 4
end
object btnOpenFile: TButton
Left = 419
Height = 22
Top = 85
Height = 21
Top = 91
Width = 24
BorderSpacing.InnerBorder = 4
Caption = '>>'
@ -160,10 +170,15 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
TabOrder = 5
end
object btnAddSubBar: TButton
Left = 420
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = lblLabel
AnchorSideTop.Side = asrBottom
Left = 455
Height = 23
Top = 84
Width = 132
Top = 91
Width = 109
BorderSpacing.Top = 6
BorderSpacing.Bottom = 21
BorderSpacing.InnerBorder = 4
Caption = 'Add S&ubbar >>'
TabOrder = 6
@ -173,7 +188,7 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
AnchorSideTop.Side = asrBottom
Left = 120
Height = 21
Top = 113
Top = 118
Width = 298
BorderSpacing.Top = 6
Font.Height = -11
@ -182,92 +197,92 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
TabOrder = 7
end
object kedtStartPath: TKASEdit
AnchorSideTop.Control = lblParameters
AnchorSideTop.Side = asrBottom
Left = 120
Height = 21
Top = 136
Top = 140
Width = 298
BorderSpacing.Top = 6
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 8
end
object kedtIconFileName: TKASEdit
AnchorSideTop.Control = lblStartPath
AnchorSideTop.Side = asrBottom
Left = 120
Height = 21
Top = 161
Top = 167
Width = 298
BorderSpacing.Top = 6
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 9
end
object btnOpenIconFile: TButton
Left = 419
AnchorSideLeft.Control = kedtIconFileName
AnchorSideLeft.Side = asrBottom
Left = 418
Height = 21
Top = 160
Top = 167
Width = 26
BorderSpacing.InnerBorder = 4
Caption = '>>'
OnClick = btnOpenIconFileClick
TabOrder = 10
end
object lbIcons: TListBox
Left = 120
Height = 54
Top = 186
Width = 298
Font.Height = -11
Font.Name = 'MS Sans Serif'
ItemHeight = 36
Style = lbOwnerDrawFixed
TabOrder = 11
end
object kedtToolTip: TKASEdit
AnchorSideTop.Control = sbIconExample
AnchorSideTop.Side = asrBottom
Left = 120
Height = 21
Top = 245
Top = 238
Width = 298
BorderSpacing.Top = 6
Font.Height = -11
Font.Name = 'MS Sans Serif'
MaxLength = 259
TabOrder = 12
TabOrder = 11
end
object btnOK: TButton
Left = 455
Height = 32
Top = 186
Top = 161
Width = 109
BorderSpacing.InnerBorder = 4
Caption = 'OK'
Default = True
OnClick = btnOKClick
TabOrder = 13
TabOrder = 12
end
object btnCancel: TButton
AnchorSideTop.Control = btnOK
AnchorSideTop.Side = asrBottom
Left = 455
Height = 32
Top = 222
Top = 197
Width = 109
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 15
TabOrder = 14
end
object btnHelp: TButton
AnchorSideTop.Control = btnCancel
AnchorSideTop.Side = asrBottom
Left = 455
Height = 32
Top = 258
Top = 233
Width = 109
BorderSpacing.Top = 4
BorderSpacing.InnerBorder = 4
Caption = '&Help'
TabOrder = 14
TabOrder = 13
end
object gbGroupBox: TGroupBox
Left = 455
@ -290,10 +305,10 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
Left = 62
Height = 21
Width = 43
Enabled = False
Font.Height = -11
Font.Name = 'MS Sans Serif'
TabOrder = 0
Text = '0'
end
object cbFlatIcons: TCheckBox
AnchorSideTop.Control = lblSize
@ -318,16 +333,20 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
Width = 79
BorderSpacing.Top = 4
Caption = 'S&mall icons'
Enabled = False
TabOrder = 2
end
end
object tbScrollBox: TScrollBox
Left = 121
AnchorSideTop.Control = stToolBarFileName
AnchorSideTop.Side = asrBottom
Left = 120
Height = 50
Top = 25
Width = 330
AutoScroll = True
TabOrder = 16
BorderSpacing.Top = 2
TabOrder = 15
object ktbBar: TKAStoolBar
Left = 1
Height = 23
@ -338,10 +357,17 @@ object frmButtonChangeDlg: TfrmButtonChangeDlg
CheckToolButton = True
end
end
object stToolBarFileName: TStaticText
Left = 120
Height = 21
Top = 2
Width = 305
BorderStyle = sbsSunken
end
object OpenDialog: TOpenDialog
Title = 'Îòêðûòü ñóùåñòâóþùèé ôàéë'
FilterIndex = 0
left = 8
top = 277
left = 496
top = 120
end
end

44
fconfigtoolbar.lrt
View file

@ -1,23 +1,21 @@
TFRMBUTTONCHANGEDLG.CAPTION=Change button bar
TFRMBUTTONCHANGEDLG.LBLBUTTONBAR.CAPTION=&Button bar:
TFRMBUTTONCHANGEDLG.LBLCOMMAND.CAPTION=&Command:
TFRMBUTTONCHANGEDLG.LBLPARAMETERS.CAPTION=&Parameters:
TFRMBUTTONCHANGEDLG.LBLSTARTPATH.CAPTION=&Start path:
TFRMBUTTONCHANGEDLG.LBLICONFILE.CAPTION=Icon &file:
TFRMBUTTONCHANGEDLG.LBLICONX.CAPTION=Ic&on:
TFRMBUTTONCHANGEDLG.LBLICONINDEX.CAPTION=0
TFRMBUTTONCHANGEDLG.LBLTOOLTIP.CAPTION=&Tooltip:
TFRMBUTTONCHANGEDLG.BTNOPENBARFILE.CAPTION=>>
TFRMBUTTONCHANGEDLG.BTNDELETEBUTTON.CAPTION=&Delete
TFRMBUTTONCHANGEDLG.BTNADDBUTTON.CAPTION=&Append
TFRMBUTTONCHANGEDLG.BTNOPENFILE.CAPTION=>>
TFRMBUTTONCHANGEDLG.BTNADDSUBBAR.CAPTION=Add S&ubbar >>
TFRMBUTTONCHANGEDLG.BTNOPENICONFILE.CAPTION=>>
TFRMBUTTONCHANGEDLG.BTNOK.CAPTION=OK
TFRMBUTTONCHANGEDLG.BTNCANCEL.CAPTION=Cancel
TFRMBUTTONCHANGEDLG.BTNHELP.CAPTION=&Help
TFRMBUTTONCHANGEDLG.GBGROUPBOX.CAPTION=Appearance
TFRMBUTTONCHANGEDLG.LBLSIZE.CAPTION=S&ize:
TFRMBUTTONCHANGEDLG.KEDTBARSIZE.TEXT=0
TFRMBUTTONCHANGEDLG.CBFLATICONS.CAPTION=F&lat icons
TFRMBUTTONCHANGEDLG.CBSMALLICONS.CAPTION=S&mall icons
TFRMCONFIGTOOLBAR.CAPTION=Change button bar
TFRMCONFIGTOOLBAR.LBLBUTTONBAR.CAPTION=&Button bar:
TFRMCONFIGTOOLBAR.LBLCOMMAND.CAPTION=&Command:
TFRMCONFIGTOOLBAR.LBLPARAMETERS.CAPTION=&Parameters:
TFRMCONFIGTOOLBAR.LBLSTARTPATH.CAPTION=&Start path:
TFRMCONFIGTOOLBAR.LBLICONFILE.CAPTION=Icon &file:
TFRMCONFIGTOOLBAR.LBLICON.CAPTION=Ic&on:
TFRMCONFIGTOOLBAR.LBLTOOLTIP.CAPTION=&Tooltip:
TFRMCONFIGTOOLBAR.BTNOPENBARFILE.CAPTION=>>
TFRMCONFIGTOOLBAR.BTNDELETEBUTTON.CAPTION=&Delete
TFRMCONFIGTOOLBAR.BTNADDBUTTON.CAPTION=&Append
TFRMCONFIGTOOLBAR.BTNOPENFILE.CAPTION=>>
TFRMCONFIGTOOLBAR.BTNADDSUBBAR.CAPTION=Add S&ubbar >>
TFRMCONFIGTOOLBAR.BTNOPENICONFILE.CAPTION=>>
TFRMCONFIGTOOLBAR.BTNOK.CAPTION=OK
TFRMCONFIGTOOLBAR.BTNCANCEL.CAPTION=Cancel
TFRMCONFIGTOOLBAR.BTNHELP.CAPTION=&Help
TFRMCONFIGTOOLBAR.GBGROUPBOX.CAPTION=Appearance
TFRMCONFIGTOOLBAR.LBLSIZE.CAPTION=S&ize:
TFRMCONFIGTOOLBAR.CBFLATICONS.CAPTION=F&lat icons
TFRMCONFIGTOOLBAR.CBSMALLICONS.CAPTION=S&mall icons

109
fconfigtoolbar.pas
View file

@ -9,26 +9,27 @@ Author : Alexander Koblov (Alexx2000@mail.ru)
contributors:
}
unit fconfigtoolbar;
unit fConfigToolBar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, KASToolBar, KASEdit;
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, KASToolBar, KASEdit,
ExtCtrls;
type
{ TfrmButtonChangeDlg }
{ TfrmConfigToolBar }
TfrmButtonChangeDlg = class(TForm)
TfrmConfigToolBar = class(TForm)
lblButtonBar: TLabel;
btnCancel: TButton;
lblCommand: TLabel;
btnCancel: TButton;
gbGroupBox: TGroupBox;
lblIconX: TLabel;
lblIconfile: TLabel;
lblIcon: TLabel;
lblIconFile: TLabel;
btnAddButton: TButton;
ktbBar: TKASToolBar;
btnOpenBarFile: TButton;
@ -37,10 +38,8 @@ type
btnDeleteButton: TButton;
btnOpenFile: TButton;
btnAddSubBar: TButton;
lbIcons: TListBox;
btnOpenIconFile: TButton;
kedtIconFileName: TKASEdit;
lblIconIndex: TLabel;
kedtParams: TKASEdit;
kedtStartPath: TKASEdit;
kedtToolTip: TKASEdit;
@ -51,10 +50,14 @@ type
btnOK: TButton;
OpenDialog: TOpenDialog;
lblParameters: TLabel;
sbIconExample: TSpeedButton;
stToolBarFileName: TStaticText;
tbScrollBox: TScrollBox;
lblSize: TLabel;
lblStartpath: TLabel;
lblTooltip: TLabel;
lblStartPath: TLabel;
lblToolTip: TLabel;
procedure btnOpenBarFileClick(Sender: TObject);
procedure cbCommandSelect(Sender: TObject);
procedure cbFlatIconsChange(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnOKClick(Sender: TObject);
@ -66,62 +69,102 @@ type
procedure btnOpenIconFileClick(Sender: TObject);
private
{ private declarations }
procedure FillActionLists;
public
{ public declarations }
end;
procedure ShowConfigToolbar;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
var
frmButtonChangeDlg: TfrmButtonChangeDlg;
LastToolButton, NewToolButton : Integer;
implementation
uses fMain, uGlobsPaths, uGlobs;
uses ActnList, LCLProc, fMain, uOSForms, uPixMapManager, uGlobsPaths, uGlobs;
procedure ShowConfigToolbar;
procedure ShowConfigToolbar(iButtonIndex : Integer = -1);
begin
with TfrmButtonChangeDlg.Create(Application) do
with TfrmConfigToolBar.Create(Application) do
try
LastToolButton := -1;
NewToolButton := -1;
ktbBar.InitBounds;
ktbBar.Tag := iButtonIndex; // Selected button index
ShowModal;
finally
Free;
end;
end;
{ TfrmButtonChangeDlg }
{ TfrmConfigToolBar }
procedure TfrmButtonChangeDlg.FormShow(Sender: TObject);
procedure TfrmConfigToolBar.FillActionLists;
var
vNum: integer;
vActions: TAction;
begin
for vNum := 0 to frmMain.actionLst.ActionCount -1 do
begin
vActions := frmMain.actionLst.Actions[vNum] as TAction;
cbCommand.Items.AddObject(vActions.Name, vActions);
end;
end;
procedure TfrmConfigToolBar.FormShow(Sender: TObject);
begin
FillActionLists;
cbFlatIcons.Checked := gToolBarFlat;
sbIconExample.Flat:= gToolBarFlat;
ktbBar.FlatButtons := gToolBarFlat;
ktbBar.ChangePath := gpExePath;
ktbBar.EnvVar := '%commander_path%';
ktbBar.LoadFromFile(gpIniDir + 'default.bar');
stToolBarFileName.Caption := gpIniDir + 'default.bar';
if ktbBar.Tag >= 0 then
begin
ktbBar.Buttons[ktbBar.Tag].Click;
ktbBar.Buttons[ktbBar.Tag].Down := True;
end;
end;
procedure TfrmButtonChangeDlg.cbFlatIconsChange(Sender: TObject);
procedure TfrmConfigToolBar.cbFlatIconsChange(Sender: TObject);
begin
ktbBar.FlatButtons := cbFlatIcons.Checked;
sbIconExample.Flat := cbFlatIcons.Checked;
end;
procedure TfrmButtonChangeDlg.btnOKClick(Sender: TObject);
procedure TfrmConfigToolBar.btnOpenBarFileClick(Sender: TObject);
begin
OpenDialog.FileName := stToolBarFileName.Caption;
OpenDialog.Filter:= '*.bar|*.bar';
if OpenDialog.Execute then
begin
ktbBar.LoadFromFile(OpenDialog.FileName);
stToolBarFileName.Caption := OpenDialog.FileName;
end;
end;
procedure TfrmConfigToolBar.cbCommandSelect(Sender: TObject);
var
vActions: TAction;
begin
vActions := cbCommand.Items.Objects[cbCommand.ItemIndex] as TAction;
kedtToolTip.Text := StringReplace(vActions.Caption, '&', '', [rfReplaceAll]);
end;
procedure TfrmConfigToolBar.btnOKClick(Sender: TObject);
begin
Save;
gToolBarFlat := cbFlatIcons.Checked;
ktbBar.SaveToFile(gpIniDir + 'default.bar');
frmMain.MainToolBar.DeleteAllToolButtons;
frmMain.MainToolBar.FlatButtons := gToolBarFlat;
//frmMain.MainToolBar.CreateWnd;
frmMain.MainToolBar.LoadFromFile(gpIniDir + 'default.bar');
Close;
end;
(*Add new button on tool bar*)
procedure TfrmButtonChangeDlg.btnAddButtonClick(Sender: TObject);
procedure TfrmConfigToolBar.btnAddButtonClick(Sender: TObject);
begin
Save;
NewToolButton := ktbBar.AddButton('', '', '', '');
@ -129,17 +172,18 @@ begin
end;
(*Select button on panel*)
procedure TfrmButtonChangeDlg.ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
procedure TfrmConfigToolBar.ktbBarToolButtonClick(Sender: TObject; NumberOfButton : Integer);
begin
Save;
cbCommand.Text := ktbBar.Commands[NumberOfButton];
kedtIconFileName.Text := ktbBar.Icons[NumberOfButton];
kedtToolTip.Text := ktbBar.Buttons[NumberOfButton].Hint;
sbIconExample.Glyph := ktbBar.Buttons[NumberOfButton].Glyph;
LastToolButton := NumberOfButton;
end;
(*Save current button*)
procedure TfrmButtonChangeDlg.Save;
procedure TfrmConfigToolBar.Save;
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
@ -158,7 +202,7 @@ begin
end;
(*Remove current button*)
procedure TfrmButtonChangeDlg.btnDeleteButtonClick(Sender: TObject);
procedure TfrmConfigToolBar.btnDeleteButtonClick(Sender: TObject);
begin
if (LastToolButton >= 0) and (ktbBar.ButtonCount > 0) then
begin
@ -171,18 +215,23 @@ begin
end;
end;
procedure TfrmButtonChangeDlg.btnOpenFileClick(Sender: TObject);
procedure TfrmConfigToolBar.btnOpenFileClick(Sender: TObject);
begin
OpenDialog.Filter:= '';
if OpenDialog.Execute then
cbCommand.Text := OpenDialog.FileName;
end;
procedure TfrmButtonChangeDlg.btnOpenIconFileClick(Sender: TObject);
procedure TfrmConfigToolBar.btnOpenIconFileClick(Sender: TObject);
var
sDir: string;
sFileName: String;
begin
if OpenDialog.Execute then
kedtIconFileName.Text := OpenDialog.FileName;
sFileName := kedtIconFileName.Text;
if ShowOpenIconDialog(Self, sFileName) then
begin
kedtIconFileName.Text := sFileName;
sbIconExample.Glyph := LoadBitmapFromFile(kedtIconFileName.Text, 32, Color);
end;
end;
initialization

26
fmain.lfm
View file

@ -4,11 +4,11 @@ object frmMain: TfrmMain
Top = 278
Width = 540
HorzScrollBar.Page = 539
VertScrollBar.Page = 315
VertScrollBar.Page = 316
VertScrollBar.Range = 79
ActiveControl = pnlNotebooks
Caption = 'Double Commander'
ClientHeight = 316
ClientHeight = 317
ClientWidth = 540
Font.Color = clBlack
Font.Height = 13
@ -79,34 +79,34 @@ object frmMain: TfrmMain
end
end
object pnlNotebooks: TPanel
Height = 240
Height = 241
Top = 49
Width = 540
Align = alClient
ClientHeight = 240
ClientHeight = 241
ClientWidth = 540
FullRepaint = False
TabOrder = 1
TabStop = True
object MainSplitter: TSplitter
Left = 171
Height = 200
Height = 201
Top = 1
Width = 4
ResizeStyle = rsLine
end
object pnlLeft: TPanel
Left = 1
Height = 200
Height = 201
Top = 1
Width = 170
Align = alLeft
BevelOuter = bvNone
ClientHeight = 200
ClientHeight = 201
ClientWidth = 170
TabOrder = 0
object nbLeft: TNotebook
Height = 176
Height = 177
Hint = 'Left'
Top = 24
Width = 170
@ -175,16 +175,16 @@ object frmMain: TfrmMain
end
object pnlRight: TPanel
Left = 175
Height = 200
Height = 201
Top = 1
Width = 364
Align = alClient
BevelOuter = bvNone
ClientHeight = 200
ClientHeight = 201
ClientWidth = 364
TabOrder = 1
object nbRight: TNotebook
Height = 176
Height = 177
Hint = 'Right'
Top = 24
Width = 364
@ -254,7 +254,7 @@ object frmMain: TfrmMain
object pnlCommand: TPanel
Left = 1
Height = 38
Top = 201
Top = 202
Width = 538
Align = alBottom
Anchors = [akLeft, akRight]
@ -302,7 +302,7 @@ object frmMain: TfrmMain
end
object pnlKeys: TPanel
Height = 27
Top = 289
Top = 290
Width = 540
Align = alBottom
Anchors = [akLeft, akRight]

5731
fmain.pas
View file

File diff suppressed because it is too large Load diff

3344
language/doublecmd.po
View file

File diff suppressed because it is too large Load diff

56
language/doublecmd.ru.po
View file

@ -1594,79 +1594,63 @@ msgstr "Показать контекстное меню"
msgid "Edit"
msgstr "Редактировать"
#: TFRMBUTTONCHANGEDLG.CAPTION
#: TFRMCONFIGTOOLBAR.CAPTION
msgid "Change button bar"
msgstr "Настройка панели инструментов"
#: TFRMBUTTONCHANGEDLG.LBLBUTTONBAR.CAPTION
#: TFRMCONFIGTOOLBAR.LBLBUTTONBAR.CAPTION
msgid "&Button bar:"
msgstr "Панель:"
#: TFRMBUTTONCHANGEDLG.LBLCOMMAND.CAPTION
#: TFRMCONFIGTOOLBAR.LBLCOMMAND.CAPTION
msgid "&Command:"
msgstr "&Команда:"
#: TFRMBUTTONCHANGEDLG.LBLPARAMETERS.CAPTION
#: TFRMCONFIGTOOLBAR.LBLPARAMETERS.CAPTION
msgid "&Parameters:"
msgstr "Параметры:"
#: TFRMBUTTONCHANGEDLG.LBLSTARTPATH.CAPTION
#: TFRMCONFIGTOOLBAR.LBLSTARTPATH.CAPTION
msgid "&Start path:"
msgstr "Путь запуска:"
#: TFRMBUTTONCHANGEDLG.LBLICONFILE.CAPTION
#: TFRMCONFIGTOOLBAR.LBLICONFILE.CAPTION
msgid "Icon &file:"
msgstr "&Файл значка"
msgstr "&Файл значка:"
#: TFRMBUTTONCHANGEDLG.LBLICONX.CAPTION
#: TFRMCONFIGTOOLBAR.LBLICON.CAPTION
msgid "Ic&on:"
msgstr "Зна&чок"
msgstr "Зна&чок:"
#: TFRMBUTTONCHANGEDLG.LBLICONINDEX.CAPTION
msgid "0"
msgstr ""
#: TFRMBUTTONCHANGEDLG.LBLTOOLTIP.CAPTION
#: TFRMCONFIGTOOLBAR.LBLTOOLTIP.CAPTION
msgid "&Tooltip:"
msgstr "Подсказка"
msgstr "Подсказка:"
#: TFRMBUTTONCHANGEDLG.BTNDELETEBUTTON.CAPTION
#: TFRMCONFIGTOOLBAR.BTNDELETEBUTTON.CAPTION
msgid "&Delete"
msgstr "Удалить"
#: TFRMBUTTONCHANGEDLG.BTNADDBUTTON.CAPTION
#: TFRMCONFIGTOOLBAR.BTNADDBUTTON.CAPTION
msgid "&Append"
msgstr "Добавить"
#: TFRMBUTTONCHANGEDLG.BTNADDSUBBAR.CAPTION
msgid "Add Subbar >>"
#: TFRMCONFIGTOOLBAR.BTNADDSUBBAR.CAPTION
msgid "Add S&ubbar >>"
msgstr "Добавить панель..."
#: TFRMBUTTONCHANGEDLG.GBGROUPBOX.CAPTION
#: TFRMCONFIGTOOLBAR.GBGROUPBOX.CAPTION
msgid "Appearance"
msgstr "Вид кнопок"
#: TFRMBUTTONCHANGEDLG.LBLSIZE.CAPTION
#: TFRMCONFIGTOOLBAR.LBLSIZE.CAPTION
msgid "S&ize:"
msgstr "&Размер"
msgstr "&Размер:"
#: TFRMBUTTONCHANGEDLG.CBFLATICONS.CAPTION
#: TFRMCONFIGTOOLBAR.CBFLATICONS.CAPTION
msgid "F&lat icons"
msgstr "Плоские"
#: TFRMBUTTONCHANGEDLG.CBSMALLICONS.CAPTION
#: TFRMCONFIGTOOLBAR.CBSMALLICONS.CAPTION
msgid "S&mall icons"
msgstr "Маленькие"
#: TFRMONEBUTTONCHANGEDLG.CAPTION
msgid "Change single button"
msgstr "Настройка панели инструментов"
#: TFRMONEBUTTONCHANGEDLG.LBLICONX.CAPTION
msgid "&Icon:"
msgstr "Зна&чок"
#: TFRMONEBUTTONCHANGEDLG.BTNADDSUBBAR.CAPTION
msgid "Add Subbar >>"
msgstr "Добавить панель..."

2
ucopythread.pas
View file

@ -159,7 +159,7 @@ begin
dst:=nil; // for safety exception handling
try
try
src:=TFileStream.Create(sSrc,fmOpenRead);
src:=TFileStream.Create(sSrc,fmOpenRead or fmShareDenyNone);
writeln(sDst);
if bAppend then
begin

58
uosforms.pas
View file

@ -27,11 +27,11 @@ unit uOSForms;
interface
uses
Classes, SysUtils, uTypes, uFileList, Menus,
Classes, SysUtils, uTypes, uFileList, Menus, Controls, Graphics, ExtDlgs,
{$IFDEF UNIX}
fFileProperties;
{$ELSE}
Windows, Messages, ShellApi, ShlObj, ActiveX, uShlObjAdditional, JwaShlGuid, JwaDbt;
FileUtil, Windows, Messages, ShellApi, ShlObj, ActiveX, uShlObjAdditional, JwaShlGuid, JwaDbt;
{$ENDIF}
const
sCmdVerbOpen = 'open';
@ -48,6 +48,7 @@ procedure SetMyWndProc(Handle : THandle);
procedure ShowFilePropertiesDialog(FileList:TFileList; const aPath:String);
procedure ShowContextMenu(Handle : THandle; pfri : PFileRecItem; X, Y : Integer);
function ShowOpenIconDialog(Owner: TCustomControl; var sFileName : String) : Boolean;
implementation
@ -382,5 +383,58 @@ begin
end;
{$ENDIF}
function ShowOpenIconDialog(Owner: TCustomControl; var sFileName : String) : Boolean;
var
opdDialog : TOpenPictureDialog;
{$IFDEF MSWINDOWS}
sFilter : String;
iPos,
iIconIndex: Integer;
bAlreadyOpen : Boolean;
{$ENDIF}
begin
opdDialog := nil;
{$IFDEF MSWINDOWS}
sFilter := GraphicFilter(TGraphic)+'|'+ 'Binary with icons(*.exe;*.dll)|*.exe;*.dll'+'|'+
Format('All files (%s)',[GetAllFilesMask]);
bAlreadyOpen := False;
iPos :=Pos(',', sFileName);
if iPos <> 0 then
begin
iIconIndex := StrToIntDef(Copy(sFileName, iPos + 1, Length(sFileName) - iPos), 0);
sFileName := Copy(sFileName, 1, iPos - 1);
end
else
begin
opdDialog := TOpenPictureDialog.Create(Owner);
opdDialog.Filter:= sFilter;;
Result:= opdDialog.Execute;
sFileName := opdDialog.FileName;
bAlreadyOpen := True;
end;
if FileIsExeLib(sFileName) then
begin
Result := SHChangeIconDialog(Owner.Handle, sFileName, iIconIndex);
if Result then
sFileName := sFileName + ',' + IntToStr(iIconIndex);
end
else if not bAlreadyOpen then
{$ENDIF}
begin
opdDialog := TOpenPictureDialog.Create(Owner);
{$IFDEF MSWINDOWS}
opdDialog.Filter:= sFilter;
{$ENDIF}
Result:= opdDialog.Execute;
sFileName := opdDialog.FileName;
{$IFDEF MSWINDOWS}
bAlreadyOpen := True;
{$ENDIF}
end;
if Assigned(opdDialog) then
FreeAndNil(opdDialog);
end;
end.

1285
upixmapmanager.pas
View file

File diff suppressed because it is too large Load diff

65
ushlobjadditional.pas
View file

@ -1789,12 +1789,13 @@ function SoftwareUpdateMessageBox(hWndOwner : HWND; szDistUnit : PWideChar; dwFl
function SHGetMalloc(var ppMalloc: IMalloc): HResult; stdcall;
function SHGetDesktopFolder(var ppshf: IShellFolder): HResult; stdcall;
function SHChangeIconDialog(hOwner: THandle; var FileName: String; var IconIndex: Integer): Boolean;
procedure OleError(ErrorCode: HResult);
procedure OleCheck(Result: HResult);
implementation
uses
ComObj;
SysUtils, ComObj;
const
shell32 = 'Shell32.dll'; //from ShellAPI, ShlObj
@ -1824,6 +1825,68 @@ function SoftwareUpdateMessageBox; external shell32 name 'SoftwareUpdateMessageB
function SHGetMalloc; external shell32 name 'SHGetMalloc';
function SHGetDesktopFolder; external shell32 name 'SHGetDesktopFolder';
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Âûçûâàåò äèàëîã âûáîðà èêîíêè. Äîðàáîòàííàÿ
Ôóíêöèÿ âûçîâà äèàëîãîâîãî îêíî "Èçìåíåíèå èêîíêè"
Çàâèñèìîñòè: Windows, SysUtils
Àâòîð: Alex Sal'nikov, alex-co@narod.ru, Ìîñêâà
Copyright: Äîðàáîòêà áèáëèîòåêè JVCL
Äàòà: 15 èþëÿ 2003 ã.
***************************************************** }
function SHChangeIconDialog(hOwner: THandle; var FileName: String; var IconIndex: Integer): Boolean;
type
TSHChangeIconProc = function(Wnd: HWND; szFileName: PChar; Reserved: Integer;
var lpIconIndex: Integer): DWORD; stdcall;
TSHChangeIconProcW = function(Wnd: HWND; szFileName: PWideChar;Reserved: Integer;
var lpIconIndex: Integer): DWORD; stdcall;
var
ShellHandle: THandle;
SHChangeIcon: TSHChangeIconProc;
SHChangeIconW: TSHChangeIconProcW;
Buf: array[0..MAX_PATH] of Char;
BufW: array[0..MAX_PATH] of WideChar;
begin
Result := False;
SHChangeIcon := nil;
SHChangeIconW := nil;
ShellHandle := Windows.LoadLibrary(PChar(Shell32));
try
if ShellHandle <> 0 then
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
SHChangeIconW := TSHChangeIconProcW(Windows.GetProcAddress(ShellHandle, PChar(62)))
else
SHChangeIcon := TSHChangeIconProc(Windows.GetProcAddress(ShellHandle, PChar(62)));
end;
if Assigned(SHChangeIconW) then
begin
StringToWideChar(FileName, BufW, SizeOf(BufW));
Result := SHChangeIconW(hOwner, BufW, SizeOf(BufW), IconIndex) = 1;
if Result then
FileName := BufW;
end
else if Assigned(SHChangeIcon) then
begin
StrPCopy(Buf, FileName);
Result := SHChangeIcon(hOwner, Buf, SizeOf(Buf), IconIndex) = 1;
if Result then
FileName := Buf;
end
else
begin
IconIndex := 0;
Result := True;
end;
finally
if ShellHandle <> 0 then
FreeLibrary(ShellHandle);
end;
end;
procedure OleError(ErrorCode: HResult);
begin
raise EOleSysError.Create('', ErrorCode, 0);