ksskinsource.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 874 行 · 第 1/2 页

{==============================================================================

  SkinEngine's SkinSource
  Copyright (C) 2000-2002 by Evgeny Kryukov
  All rights reserved

  All conTeThements of this file and all other files included in this archive
  are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

  $Id: KsSkinSource.pas,v 1.3 2002/10/28 21:04:21 Evgeny Exp $

===============================================================================}

unit KsSkinSource;

{$I se_define.inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, se_controls, KsSkinObjects;

type

  TSeSkinSource = class;

{ TSeSkinFilter }

  TSeSkinFilter = class(TPersistent)
  private
    FSkinSource: TSeSkinSource;
    procedure SetSkinSource(const Value: TSeSkinSource);
  protected
    procedure ReadSkinSource(Stream: TStream); virtual;
    procedure WriteSkinSource(Stream: TStream); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    { }
    class function GetFileExtension: string; virtual;
    class function GetFilterName: string; virtual;
    { Filter }
    procedure ReadSkin(Stream: TStream); virtual;
    procedure WriteSkin(Stream: TStream); virtual;
    { Property }
    property SkinSource: TSeSkinSource read FSkinSource write SetSkinSource;
  end;

  TSeSkinFilterClass = class of TSeSkinFilter;

{ TSeSkinFilterUncompressed }

  TSeSkinFilterUncompressed = class(TSeSkinFilter)
  public
    constructor Create; override;
    { }
    class function GetFileExtension: string; override;
    class function GetFilterName: string; override;
    { Filter }
    procedure ReadSkin(Stream: TStream); override;
    procedure WriteSkin(Stream: TStream); override;
  end;

{ TSeSkinFilterCompressed }

  TSeSkinFilterCompressed = class(TSeSkinFilter)
  public
    constructor Create; override;
    { }
    class function GetFileExtension: string; override;
    class function GetFilterName: string; override;
    { Filter }
    procedure ReadSkin(Stream: TStream); override;
    procedure WriteSkin(Stream: TStream); override;
  end;

{ TSeSkinFilterUltraCompressed }

  TSeSkinFilterUltraCompressed = class(TSeSkinFilter)
  public
    constructor Create; override;
    { }
    class function GetFileExtension: string; override;
    class function GetFilterName: string; override;
    { Filter }
    procedure ReadSkin(Stream: TStream); override;
    procedure WriteSkin(Stream: TStream); override;
  end;

{ TSeSkinFilterMaxCompression }

  TSeSkinFilterMaxCompression = class(TSeSkinFilterUltraCompressed)
  protected
    procedure ReadSkinSource(Stream: TStream); override;
    procedure WriteSkinSource(Stream: TStream); override;
  public
    constructor Create; override;
    { }
    class function GetFileExtension: string; override;
    class function GetFilterName: string; override;
    { Filter }
  end;

{ TSeSkinSource }

  TSeSkinSource = class(TComponent)
  private
    { Private declarations }
    FSkinName: string;
    FAuthorURL: string;
    FSkinVersion: string;
    FAuthor: string;
    FAuthorEMail: string;
    { Objects and images }
    FObjects: TList;
    FBitmaps: TSeBitmapList;
    FSounds: TList;
    { States }
    FIsChanging: boolean;
    FDeltaHue: integer;
    FBitmapHue: integer;
    { Objects }
    function GetForm: TSeSkinObject;
    { Properties }
    function GetObject(index: integer): TSeSkinObject;
    function GetCount: integer;
    procedure SetDeltaHue(const Value: integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { I/O methods}
    procedure LoadFromStream(Stream: TStream); dynamic;
    procedure SaveToStream(Stream: TStream); dynamic;
    procedure LoadFromFile(FileName: string); dynamic;
    procedure SaveToFile(FileName: string); dynamic;
    { Assign and copy methods }
//    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    { Objects }
    procedure Add(SkinObject: TSeSkinObject);
    procedure Remove(SkinObject: TSeSkinObject);
    function GetObjectByKind(Kind: TSeKind): TSeSkinObject;
    function GetObjectByName(Name: string): TSeSkinObject;
    procedure ReplaceBitmap(Source, Dest: TSeBitmap);
    { Public property }
    property Count: integer read GetCount;
    property Objects[index: integer]: TSeSkinObject read GetObject; default;
    property Bitmaps: TSeBitmapList read FBitmaps;
    property Sounds: TList read FSounds;
    property DeltaHue: integer read FDeltaHue write SetDeltaHue;
    { Necessary objects }
    property Form: TSeSkinObject read GetForm;
    { States }
    property IsChanging: boolean read FIsChanging write FIsChanging;
  published
    { Published declarations }
    property SkinName: string read FSkinName write FSkinName;
    property SkinVersion: string read FSkinVersion write FSkinVersion;
    property Author: string read FAuthor write FAuthor;
    property AuthorEMail: string read FAuthorEMail write FAuthorEMail;
    property AuthorURL: string read FAuthorURL write FAuthorURL;
  end;

const

  DefaultFilter: TSeSkinFilterClass = TSeSkinFilterCompressed;

procedure RegisterSkinFilter(AFilter: TSeSkinFilterClass);
procedure UnregisterSkinFilter(AFilter: TSeSkinFilterClass);

function GetSkinFilterByFileName(FileName: string): TSeSkinFilterClass;
function GetDialogFilter: string;

implementation {===============================================================}

uses KsSkinVersion, se_zstream;

const
  KsZSign: array [0..3] of char = 'KSLZ';

var
  Filters: TList;

{ Filter routines }

procedure RegisterSkinFilter(AFilter: TSeSkinFilterClass);
begin
  Filters.Add(AFilter);
end;

procedure UnregisterSkinFilter(AFilter: TSeSkinFilterClass);
begin
  Filters.Remove(AFilter);
end;

function GetSkinFilterByFileName(FileName: string): TSeSkinFilterClass;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Filters.Count - 1 do
    if LowerCase(ExtractFileExt(FileName)) = '.'+LowerCase(TSeSkinFilterClass(Filters[i]).GetFileExtension) then
    begin
      Result := TSeSkinFilterClass(Filters[i]);
      Exit;
    end;
end;

function GetDialogFilter: string;
var
  i: integer;
  AllStr, Str: string;
begin
  AllStr := '';
  Result := '';

  for i := 0 to Filters.Count - 1 do
  begin
    if i <> 0 then
    begin
      Result := Result + '|';
      AllStr := AllStr + ';';
    end;
    
    Str := '*.' + TSeSkinFilterClass(Filters[i]).GetFileExtension;
    AllStr := AllStr + Str; 
    Result := Result + TSeSkinFilterClass(Filters[i]).GetFilterName + ' ' + '(' + Str + ')' + '|' + Str;
  end;

  Result := 'All (' + AllStr + ')|' + AllStr + '|' + Result;
end;

{ TSeSkinSource ===============================================================}

constructor TSeSkinSource.Create(AOwner: TComponent);
begin
  inherited;
  FSkinName := 'SkinEngine Skin';
  FSkinVersion := sSeSkinVersion;
  FAuthor := 'KS Development';
  FAuthorEMail := '[e-mail]';
  FAuthorURL := 'http://www.ksdev.com';
  
  FObjects := TList.Create;
  FBitmaps := TSeBitmapList.Create;
  FSounds := TList.Create;
end;

destructor TSeSkinSource.Destroy;
begin
  Clear;

  FSounds.Free;
  FBitmaps.Free;
  FObjects.Free;
  inherited;
end;

procedure TSeSkinSource.Clear;
var
  i: integer;
begin
{  for i := 0 to FSounds.Count-1 do
    TscSound(FSounds[i]).Free; }
  FSounds.Clear;

  FBitmaps.Clear;

  for i := 0 to FObjects.Count-1 do
    TSeSkinObject(FObjects[i]).Free;
  FObjects.Clear;
end;

{ I/O Routines ================================================================}

procedure TSeSkinSource.LoadFromStream(Stream: TStream);
var
  Filter: TSeSkinFilter;
begin
  Filter := DefaultFilter.Create;
  try
    Filter.SkinSource := Self;
    Filter.ReadSkin(Stream);
  finally
    Filter.Free;
  end;
end;

procedure TSeSkinSource.SaveToStream(Stream: TStream);
var
  Filter: TSeSkinFilter;
begin
  Filter := DefaultFilter.Create;
  try
    Filter.SkinSource := Self;
    Filter.WriteSkin(Stream);
  finally
    Filter.Free;
  end;
end;

procedure TSeSkinSource.LoadFromFile(FileName: string);
var
  Stream: TStream;
  Filter: TSeSkinFilter;
  FilterClass: TSeSkinFilterClass;
begin
  { Check file }
  if FileName = '' then Exit;
  if not FileExists(FileName) then
  begin
    if FileName[2] <> ':' then
    begin
      FileName := ExtractFilePath(ParamStr(0))+FileName;
      if not FileExists(FileName) then Exit;
    end
    else
      Exit;
  end;

  { Get filter }
  FilterClass := GetSkinFilterByFileName(FileName);

  if FilterClass <> nil then
  begin
    Stream := TfileStream.Create(FileName, fmOpenRead);
    try
      Filter := FilterClass.Create;
      try
        Filter.SkinSource := Self;

        Filter.ReadSkin(Stream);
      finally
        Filter.Free;
      end;
    finally
      Stream.Free;
    end;
  end;
end;

procedure TSeSkinSource.SaveToFile(FileName: string);
var
  Stream: TStream;
  Filter: TSeSkinFilter;
  FilterClass: TSeSkinFilterClass;
begin
  if FileName = '' then Exit;

  { Get filter }
  FilterClass := GetSkinFilterByFileName(FileName);
  if FilterClass = nil then
    FilterClass := DefaultFilter;

  if FilterClass <> nil then
  begin
    Stream := TFileStream.Create(FileName, fmCreate);
    try
      Filter := FilterClass.Create;
      try
        Filter.SkinSource := Self;

        Filter.WriteSkin(Stream);
      finally
        Filter.Free;
      end;
    finally
      Stream.Free;
    end;
  end;
end;

{ Objects routines ============================================================}

procedure TSeSkinSource.Add(SkinObject: TSeSkinObject);
begin
  FObjects.Add(SkinObject);
end;

procedure TSeSkinSource.Remove(SkinObject: TSeSkinObject);
begin
  FObjects.Remove(SkinObject);
end;

{ Get form object =============================================================}

function TSeSkinSource.GetObjectByKind(Kind: TSeKind): TSeSkinObject;
var
  i: integer;
begin
  for i := 0 to FObjects.Count-1 do
    if Objects[i].Kind = Kind then
    begin
      Result := Objects[i];
      Exit;
    end;
  Result := nil;
end;

function TSeSkinSource.GetObjectByName(Name: string): TSeSkinObject;
var
  i: integer;
begin
  for i := 0 to FObjects.Count-1 do
    if LowerCase(Objects[i].Name) = LowerCase(Name) then
    begin
      Result := Objects[i];
      Exit;
    end;
  Result := nil;
end;

function TSeSkinSource.GetForm: TSeSkinObject;
begin
  Result := GetObjectByName('Form');
  if Result = nil then
    Result := GetObjectByKind(skForm);
end;

procedure TSeSkinSource.ReplaceBitmap(Source, Dest: TSeBitmap);
var
  i, Index: integer;
begin
  if (Source = nil) or (Dest = nil) then Exit;
  if Bitmaps.Count = 0 then Exit;
  if Count = 0 then Exit;

  Dest.Name := Source.Name;