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

initial commit from lost SVN repo

Browse Source
This commit is contained in:
fatalerrors
2023-10-06 15:59:41 +02:00
parent 8186c7b10e
commit f600f5706a
1496 changed files with 666909 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

251
common/uiconmanager.pas Normal file
View File

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