348 lines
12 KiB
ObjectPascal
348 lines
12 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
YaPeTaVi - Yet another Periodic Table Viewer
|
|
Copyright (C) 2009-2012 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
All rights reserved.
|
|
http://www.geoffray-levasseur.org/
|
|
|
|
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 3 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.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
Icons "on the fly" manager
|
|
|
|
}
|
|
|
|
unit uIconManager;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Controls, Classes, SysUtils, Forms, Graphics;
|
|
|
|
type
|
|
TIconSize = (is8x8, is16x16, is22x22, is32x32, is48x48);
|
|
TIconSetsList = array[0..127] of string;
|
|
|
|
const
|
|
IconSizeDir: array[TIconSize] of string =
|
|
('8x8', '16x16', '22x22', '32x32', '48x48');
|
|
DefaultTheme = 'oxygen'; //this not the iconset name but its directory name
|
|
DefaultIconSize: TIconSize = is16x16;
|
|
DefaultButtonIcon = 'actions/cancel.png';
|
|
NumberOfIcons = 39;
|
|
{$ifndef WINDOWS}
|
|
NewIconNames: array[0..NumberOfIcons - 1] of string =
|
|
('actions/document-new.png', 'actions/document-new-from-template.png', //0
|
|
'actions/document-open.png', 'actions/view-refresh.png', //2
|
|
'actions/document-save.png', 'actions/document-save-all.png', //4
|
|
'actions/dialog-close.png', 'actions/document-print.png', //6
|
|
'actions/document-preview.png', 'actions/application-exit.png', //8
|
|
'actions/document-print-preview.png', 'actions/edit-undo.png', //10
|
|
'actions/edit-redo.png', 'actions/edit-cut.png', //12
|
|
'actions/edit-copy.png', 'actions/edit-paste.png', //14
|
|
'apps/preferences-system-time.png', 'actions/insert-text.png', //16
|
|
'actions/mail-send.png', 'actions/document-save-as.png', //18
|
|
'actions/document-export.png', 'actions/document-open-recent.png', //20
|
|
'actions/dialog-ok.png', 'actions/dialog-cancel.png', //22
|
|
'actions/dialog-ok-apply.png', 'actions/dialog-close.png', //24
|
|
'actions/help-about.png', 'actions/edit-find.png', //26
|
|
'actions/go-next.png', 'actions/go-previous.png', //28
|
|
'actions/go-jump.png', 'actions/help-contents.png', //30
|
|
'actions/edit-clear.png', 'actions/system-run.png', //32
|
|
'actions/configure.png', 'actions/help-hint.png', //34
|
|
'actions/list-add.png', 'actions/list-remove.png', //36
|
|
'actions/im-status-message-edit.png');
|
|
{$else}
|
|
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', 'system-run.png', //32
|
|
'configure.png', 'help-hint.png', //34
|
|
'list-add.png', 'list-remove.png', //36
|
|
'im-status-message-edit.png');
|
|
{$endif}
|
|
|
|
//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;
|
|
icAdd = 36;
|
|
icChange = 38;
|
|
icRemove = 37;
|
|
icDelete = icRemove;
|
|
icUp = 40;
|
|
icDown = 39;
|
|
icSystem = 33;
|
|
|
|
var
|
|
ilDefault: TImageList;
|
|
IconSetsList: TIconSetsList;
|
|
|
|
//load a new theme and apply the changes
|
|
procedure LoadIconSet(Path, Theme: string; Size: TIconSize);
|
|
|
|
//set button icons on the fly
|
|
procedure InitBtnGlyphs(Form: TForm);
|
|
|
|
//find Oxygen icon set (default)
|
|
function FindOxygen: string;
|
|
|
|
//get a list of installed icon set
|
|
procedure GetIconSets(BaseDir: string; var IcSets: TIconSetsList);
|
|
|
|
//get the home of icon sets deppending on the host OS
|
|
function GetIconSetsBaseDir: string;
|
|
|
|
//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, uConst, 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('Add icon ' + Path + NewIconNames[Index] + '... ', vlHigh);
|
|
//only png format is supported
|
|
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)
|
|
PrintDbgResult(' 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);
|
|
PrintDbgResult(True, vlHigh);
|
|
end;
|
|
|
|
function FindOxygen: string;
|
|
{$warning add BSD, MacOs and Unix support if different path}
|
|
{$warning we should give user the ability to give that path manually}
|
|
begin
|
|
{$ifdef WINDOWS}
|
|
//Oxygen is not supposed to exist with Windows so its bringed with the app
|
|
Result := sPrgmPath + '..\icons\Oxygen\';
|
|
{$else}
|
|
//if KDE (or just Oxygen) is installed on unixes, try to find it
|
|
if DirectoryExists('/usr/share/icons/oxygen') then //debian, *ubuntu, opensuse
|
|
Result := '/usr/share/icons/oxygen/'
|
|
else if DirectoryExists('/opt/kde/share/icons/oxygen') then //fedora
|
|
Result := '/opt/kde/share/icons/oxygen/'
|
|
else if DirectoryExists('/opt/kde4/share/icons/oxygen') then //mandriva
|
|
Result := '/opt/kde4/share/icons/oxygen/'
|
|
else Result := ''; //probably not installed or non standard paths
|
|
{$endif}
|
|
PrintLnDbg('Found Oxygen icons: ' + Result, vlLow);
|
|
end;
|
|
|
|
procedure LoadIconSet(Path, Theme: string; Size: TIconSize);
|
|
var
|
|
IconBaseDir: string;
|
|
I: Integer;
|
|
begin
|
|
//Size := is16x16;
|
|
//set iconset path correctly in a unix minded approach
|
|
IconBaseDir := Path;
|
|
if IconBaseDir[Length(IconBaseDir)] <> DirectorySeparator then
|
|
IconBaseDir := IconBaseDir + DirectorySeparator;
|
|
if Theme[Length(Theme)] <> DirectorySeparator then
|
|
IconBaseDir := IconBaseDir + Theme + DirectorySeparator
|
|
else IconBaseDir := IconBaseDir + Theme;
|
|
IconBaseDir := IconBaseDir + IconSizeDir[Size] + DirectorySeparator;
|
|
PrintDbg('-- Trying to find icon theme ' + IconBaseDir, vlHigh);
|
|
Inc(DebugLevel);
|
|
//check iconset existance
|
|
if not DirectoryExists(IconBaseDir) then
|
|
begin
|
|
//if unavailable rolling back to Oxygen
|
|
PrintLnDbg('', vlHigh);
|
|
PrintLnDbg('*** uIconManager.LoadIconSet: ERROR: ' + IconBaseDir +
|
|
' directory do not exists! Trying to find Oxygen...', vlHigh);
|
|
IconBaseDir := FindOxygen;
|
|
if IconBaseDir <> '' then
|
|
begin
|
|
PrintLnDbg('Found Oxygen icons: ' + IconBaseDir, vlHigh);
|
|
IconBaseDir := IconBaseDir + IconSizeDir[Size] + DirectorySeparator;
|
|
PrintDbg('Loading Oxygen in ' + IconBaseDir, vlHigh);
|
|
end else
|
|
begin
|
|
//no Oxygen as well: show a warning
|
|
PrintLnDbg('*** uIconManager.LoadIconSet: ERROR: Can''t find Oxygen ' +
|
|
'icons: No icon available, please choose a valid icon theme!', vlHigh);
|
|
PrintLnDbg('!!! uIconManager.LoadIconSet: Warning: The application ' +
|
|
'may look uggly but should be usable.', vlHigh);
|
|
Dec(DebugLevel);
|
|
PrintLnDbg('-- *** Errors remainings', vlHigh);
|
|
Exit; //find oxigen here
|
|
end;
|
|
end else
|
|
write('.');
|
|
try
|
|
//free the image list to be sure it'll not poluted with previous datas
|
|
ilDefault.Free;
|
|
write('.');
|
|
finally
|
|
//create an image liste with the good size
|
|
case DefaultIconSize of
|
|
is8x8: ilDefault := TImageList.CreateSize(8, 8);
|
|
is16x16: ilDefault := TImageList.CreateSize(16, 16);
|
|
is22x22: ilDefault := TImageList.CreateSize(22, 22);
|
|
is32x32: ilDefault := TImageList.CreateSize(32, 32);
|
|
end;
|
|
write('.');
|
|
end;
|
|
Dec(DebugLevel);
|
|
PrintLnDbg('-- 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('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;
|
|
|
|
procedure GetIconSets(BaseDir: string; var IcSets: TIconSetsList);
|
|
var
|
|
SR: TSearchRec;
|
|
I: integer;
|
|
begin
|
|
for I := 0 to 127 do
|
|
IcSets[I] := '';
|
|
I := 0;
|
|
if FindFirst(BaseDir + '*', faDirectory, SR) = 0 then //get subdirs
|
|
repeat
|
|
PrintDbg('Found ' + BaseDir + SR.Name + ' directory, checking for icons...',
|
|
vlLow);
|
|
//if there's 16x16 dir this should really be icons
|
|
if DirectoryExists(BaseDir + SR.Name + '/16x16') then
|
|
if I <= 127 then
|
|
begin
|
|
IcSets[I] := SR.Name;
|
|
PrintDbgResult(' yes', vlLow);
|
|
Inc(I);
|
|
end else
|
|
PrintDbgResult(' error: too many icon sets', vlLow)
|
|
else
|
|
PrintDbgResult(' no', vlLow);
|
|
until FindNext(SR) <> 0;
|
|
FindClose(SR);
|
|
end;
|
|
|
|
function GetIconSetsBaseDir: string;
|
|
begin
|
|
{$ifdef WINDOWS}
|
|
Result := sPrgmPath + '..\icons\';
|
|
{$else}
|
|
if DirectoryExists('/usr/share/icons/') then
|
|
Result := '/usr/share/icons/'
|
|
else if DirectoryExists('/opt/kde/share/icons/') then
|
|
Result := '/opt/kde/share/icons/oxygen/'
|
|
else if DirectoryExists('/opt/kde4/share/icons/') then
|
|
Result := '/opt/kde4/share/icons/oxygen/'
|
|
else if DirectoryExists('/opt/kde/share/icons/') then
|
|
Result := '/opt/gnome/share/icons/'
|
|
else Result := ''; //probably not installed or non standard paths
|
|
{$endif}
|
|
PrintLnDbg('Found base icon sets dir: ' + Result, vlLow);
|
|
end;
|
|
|
|
initialization
|
|
|
|
end.
|
|
|