fatalerrors/yapetavi
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial commit moved from svn

Browse Source
This commit is contained in:
fatalerrors
2022-10-24 22:07:20 +02:00
parent b2caa19213
commit 0e96f4f5e4
229 changed files with 20039 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

347
uiconmanager.pas Normal file
View File

@@ -0,0 +1,347 @@
{
********************************************************************************
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.