sinternalskins.pas

AlphaControls是一个Delphi标准控件的集合

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.