?? sinternalskins.pas
字號:
unit sInternalSkins;
{$I sDefs.inc}
{$IFDEF DELPHI6UP}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, sSkinManager, FileCtrl, sUtils, ActnList,
sButtonControl, sCustomButton, sSkinProvider, ExtCtrls, sPanel;
type
TFormInternalSkins = class(TForm)
ActionList1: TActionList;
ActionAddNew: TAction;
ActionDelete: TAction;
ActionRename: TAction;
ActionClose: TAction;
sSkinProvider1: TsSkinProvider;
ListBox1: TListBox;
sBitBtn1: TsButton;
sPanel1: TsPanel;
sButton2: TsButton;
sButton3: TsButton;
sButton4: TsButton;
sButton1: TsButton;
sButton5: TsButton;
ActionClear: TAction;
ActionExtract: TAction;
procedure ActionAddNewExecute(Sender: TObject);
procedure ActionCloseExecute(Sender: TObject);
procedure ActionRenameExecute(Sender: TObject);
procedure ActionDeleteExecute(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ActionExtractExecute(Sender: TObject);
procedure ActionClearExecute(Sender: TObject);
private
{ Private declarations }
public
NewName : string;
NewPath : string;
SkinManager : TsSkinManager;
{ Public declarations }
procedure AddNewSkin;
procedure UpdateMyActions;
end;
var
FormInternalSkins: TFormInternalSkins;
implementation
uses IniFiles;
{$R *.DFM}
procedure TFormInternalSkins.AddNewSkin;
var
sf : TMemIniFile;
s : string;
begin
NewName := ExtractWord(WordCount(NewPath, ['/', '\']), NewPath, ['/', '\']) + ' (internal)';
s := NormalDir(NewPath) + 'Options.dat';
if FileExists(s) then begin
SkinManager.InternalSkins.Add;
SkinManager.InternalSkins[SkinManager.InternalSkins.Count - 1].Name := NewName;
sf := TMemIniFile.Create(s);
try
SkinManager.InternalSkins.Items[SkinManager.InternalSkins.Count - 1].LoadSkin(sf);
finally
ListBox1.Items.Add(NewName);
if Assigned(sf) then FreeAndNil(sf);
end;
end
else begin
ShowWarning('File Options.dat with skin data is not exists');
end;
end;
procedure TFormInternalSkins.ActionAddNewExecute(Sender: TObject);
begin
NewPath := SkinManager.SkinDirectory;
if SelectDirectory(NewPath, [], 0) then begin
if DirExists(NewPath) then begin
AddNewSkin;
end;
end;
UpdateMyActions;
end;
procedure TFormInternalSkins.ActionCloseExecute(Sender: TObject);
begin
Close;
end;
procedure TFormInternalSkins.ActionRenameExecute(Sender: TObject);
var
i : integer;
s : string;
begin
s := ListBox1.Items[ListBox1.ItemIndex];
if InputQuery('String input', 'Enter new name :', s) then begin
if ListBox1.ItemIndex > -1 then begin
for i := 0 to SkinManager.InternalSkins.Count - 1 do begin
if SkinManager.InternalSkins.Items[i].Name = ListBox1.Items[ListBox1.ItemIndex] then begin
SkinManager.InternalSkins.Items[i].Name := s;
break;
end;
end;
ListBox1.Items[ListBox1.ItemIndex] := s;
end;
UpdateMyActions;
end;
end;
procedure TFormInternalSkins.ActionDeleteExecute(Sender: TObject);
var
i : integer;
begin
if ListBox1.ItemIndex > -1 then begin
for i := 0 to SkinManager.InternalSkins.Count - 1 do begin
if SkinManager.InternalSkins.Items[i].Name = ListBox1.Items[ListBox1.ItemIndex] then begin
SkinManager.InternalSkins.Delete(i);
break;
end;
end;
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
UpdateMyActions;
end;
procedure TFormInternalSkins.ListBox1Click(Sender: TObject);
begin
UpdateMyActions;
end;
procedure TFormInternalSkins.FormShow(Sender: TObject);
begin
UpdateMyActions;
ReleaseCapture;
sButton1.sStyle.Invalidate;
sButton2.sStyle.Invalidate;
sButton3.sStyle.Invalidate;
sButton4.sStyle.Invalidate;
sButton5.sStyle.Invalidate;
sBitBtn1.sStyle.Invalidate;
end;
procedure TFormInternalSkins.UpdateMyActions;
begin
ActionDelete.Enabled := ListBox1.ItemIndex > -1;
ActionRename.Enabled := ListBox1.ItemIndex > -1;
ActionExtract.Enabled := ListBox1.ItemIndex > -1;
ActionClear.Enabled := ListBox1.Items.Count > 0;
end;
procedure TFormInternalSkins.ActionExtractExecute(Sender: TObject);
var
s : string;
begin
s := '\';
SelectDirectory(s, [], -1);
if s <> '\' then begin
SkinManager.ExtractInternalSkin(ListBox1.Items[ListBox1.ItemIndex], s);
end;
end;
procedure TFormInternalSkins.ActionClearExecute(Sender: TObject);
begin
if Customrequest('Do you really want to delete all internal skins?') then begin
while SkinManager.InternalSkins.Count > 0 do begin
SkinManager.InternalSkins.Delete(0);
end;
ListBox1.Items.Clear;
UpdateMyActions;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -