252 lines
8.3 KiB
ObjectPascal
252 lines
8.3 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui (common files)
|
|
Copyright (C) 2009-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://0.tuxfamilly.org/
|
|
http://www.geoffray-levasseur.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
Icons "on the fly" manager
|
|
|
|
********************************************************************************
|
|
}
|
|
|
|
unit uIconManager;
|
|
|
|
{$include defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Controls, Classes, SysUtils, Forms, Graphics;
|
|
|
|
const
|
|
DefaultButtonIcon = 'dialog-cancel.png';
|
|
NumberOfIcons = 49;
|
|
|
|
//the following is actual freedesktop standard :
|
|
NewIconNames: array[0..NumberOfIcons - 1] of string =
|
|
('document-new.png', 'document-new-from-template.png', //0
|
|
'document-open.png', 'view-refresh.png', //2
|
|
'document-save.png', 'document-save-all.png', //4
|
|
'dialog-close.png', 'document-print.png', //6
|
|
'document-preview.png', 'application-exit.png', //8
|
|
'document-print-preview.png', 'edit-undo.png', //10
|
|
'edit-redo.png', 'edit-cut.png', //12
|
|
'edit-copy.png', 'edit-paste.png', //14
|
|
'preferences-system-time.png', 'insert-text.png', //16
|
|
'mail-send.png', 'document-save-as.png', //18
|
|
'document-export.png', 'document-open-recent.png', //20
|
|
'dialog-ok.png', 'dialog-cancel.png', //22
|
|
'dialog-ok-apply.png', 'dialog-close.png', //24
|
|
'help-about.png', 'edit-find.png', //26
|
|
'go-next.png', 'go-previous.png', //28
|
|
'go-jump.png', 'help-contents.png', //30
|
|
'edit-clear.png', 'applications-system.png', //32
|
|
'configure.png', 'help-hint.png', //34
|
|
'list-add.png', 'list-remove.png', //36
|
|
'im-status-message-edit.png', 'arrow-down.png', //38
|
|
'arrow-up.png', 'media-playback-pause.png', //40
|
|
'document-properties.png', 'edit-select-all.png', //42
|
|
'video-display.png', 'tools-report-bug.png', //44
|
|
'help-contents.png', 'repository.png', //46
|
|
'preferences-desktop-font.png');
|
|
|
|
//this is more easy than learning icon's index
|
|
const
|
|
icClose = 6;
|
|
icCancel = 23;
|
|
icYes = 22;
|
|
icNo = 6;
|
|
icOk = 22;
|
|
icApply = 24;
|
|
icNew = 0;
|
|
icOpen = 2;
|
|
icSave = 4;
|
|
icSaveAll = 5;
|
|
icExit = 9;
|
|
icUndo = 11;
|
|
icRedo = 12;
|
|
icCopy = 14;
|
|
icCut = 13;
|
|
icPaste = 15;
|
|
icRefresh = 3;
|
|
icAbout = 26;
|
|
icSearch = 27;
|
|
icAdd = 36;
|
|
icChange = 38;
|
|
icRemove = 37;
|
|
icDelete = icRemove;
|
|
icUp = 34;
|
|
icDown = 39;
|
|
icSystem = 33;
|
|
icProperties = 42;
|
|
icSettings = 34;
|
|
icParameters = icSettings;
|
|
icPause = 41;
|
|
icDisplay = 44;
|
|
icSelectAll = 43;
|
|
icReportBug = 45;
|
|
icManual = 46;
|
|
icRepository = 47;
|
|
icFontSettings = 48;
|
|
|
|
var
|
|
ilDefault: TImageList;
|
|
|
|
//load a new theme and apply the changes
|
|
procedure LoadIconSet(Path: string);
|
|
|
|
//set button icons on the fly
|
|
procedure InitBtnGlyphs(Form: TForm);
|
|
|
|
//for color configuration create an icon on the fly showing the selected color
|
|
function CreateColorGlyph(Color: TColor; Width, Height: integer): TBitmap;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Dialogs, Buttons, uUtils, uDebug;
|
|
|
|
function CreateColorGlyph(Color: TColor; Width, Height: integer): TBitmap;
|
|
var
|
|
X, Y: integer;
|
|
begin
|
|
//create an empty bitmap and set its size
|
|
Result := TBitmap.Create;
|
|
Result.SetSize(Width, Height);
|
|
//fill it with the given color
|
|
for X := 0 to Width do
|
|
for Y := 0 to Height do
|
|
Result.Canvas.Pixels[X, Y] := Color;
|
|
end;
|
|
|
|
function AddIcon(Index: Integer; Path: string): Boolean;
|
|
var
|
|
Bitmap: TPortableNetworkGraphic;
|
|
X, Y: integer;
|
|
begin
|
|
PrintDbg('i Add icon "' + Path + NewIconNames[Index] + '"... ', vlHigh);
|
|
//only png format is supported
|
|
try
|
|
Result := True;
|
|
try
|
|
Bitmap := TPortableNetworkGraphic.Create;
|
|
if not FileExists(Path + NewIconNames[Index]) then //the icon is not present
|
|
begin
|
|
//we have to create an empty bitmap (and hopping it's gonna be seen as all transparent)
|
|
PrintDbg('not fount, create empty one: ', vlHigh);
|
|
Bitmap.SetSize(ilDefault.Width, ilDefault.Height);
|
|
for X := 0 to ilDefault.Width do
|
|
for Y := 0 to ilDefault.Height do
|
|
//actually this draw a boxed X
|
|
if (X = Y) or (ilDefault.Width - X = Y + 1) or (X = 0) or (Y = 0) or
|
|
(X = ilDefault.Width - 1) or (Y = ilDefault.Height - 1) then
|
|
Bitmap.Canvas.Pixels[X, Y] := clBtnText
|
|
else
|
|
Bitmap.Canvas.Pixels[X, Y] := clBtnFace;
|
|
//set transparancy settings
|
|
Bitmap.TransparentColor := clBtnFace;
|
|
Bitmap.Transparent := True;
|
|
end else
|
|
begin
|
|
//load the bitmap and set transparency on
|
|
Bitmap.LoadFromFile(Path + NewIconNames[Index]);
|
|
Bitmap.Transparent := True;
|
|
end;
|
|
//add this to the image list
|
|
ilDefault.Add(Bitmap, nil);
|
|
except
|
|
Result := False;
|
|
end;
|
|
finally
|
|
Bitmap.Free;
|
|
end;
|
|
PrintDbgResult(Result, vlHigh)
|
|
end;
|
|
|
|
procedure LoadIconSet(Path: string);
|
|
var
|
|
IconBaseDir: string;
|
|
I: Integer;
|
|
begin
|
|
IconBaseDir := Path;
|
|
if IconBaseDir[Length(IconBaseDir)] <> DirectorySeparator then
|
|
IconBaseDir := IconBaseDir + DirectorySeparator;
|
|
//check iconset existance
|
|
if not DirectoryExists(IconBaseDir) then
|
|
begin
|
|
//if unavailable rolling back to Oxygen
|
|
PrintLnDbg('E uIconManager.LoadIconSet: "' + IconBaseDir +
|
|
'" directory does not exists!', vlHigh);
|
|
PrintLnDbg('W uIconManager.LoadIconSet: The application ' +
|
|
'may look uggly but should be usable.', vlHigh);
|
|
end;
|
|
try
|
|
//free the image list to be sure it'll not poluted with previous datas
|
|
ilDefault.Free;
|
|
finally
|
|
//create an image liste with the good size
|
|
ilDefault := TImageList.CreateSize(22, 22);
|
|
end;
|
|
PrintLnDbg('i Initializing icon set done.', vlHigh);
|
|
//add the icons in the newly created image list
|
|
for I:= 0 to NumberOfIcons - 1 do
|
|
AddIcon(I, IconBaseDir);
|
|
end;
|
|
|
|
procedure InitBtnGlyphs(Form: TForm);
|
|
var
|
|
I: integer;
|
|
Bitmap: TBitmap;
|
|
begin
|
|
for I := 0 to Form.ComponentCount - 1 do
|
|
if (Form.Components[I] is TBitBtn) and (Form.Components[I].Tag <> -1) then
|
|
try
|
|
PrintDbg('i Init "' + Form.Components[I].Name + '" button glyph... ',
|
|
vlHigh);
|
|
Bitmap := TBitmap.Create;
|
|
ilDefault.GetBitmap((Form.Components[I] as TBitBtn).Tag, Bitmap);
|
|
(Form.Components[I] as TBitBtn).Glyph := Bitmap;
|
|
PrintDbgResult(True, vlHigh);
|
|
except
|
|
PrintDbgResult(False, vlHigh);
|
|
end;
|
|
end;
|
|
|
|
initialization
|
|
|
|
end.
|
|
|