cximagelisteditor.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,122 行 · 第 1/3 页

{********************************************************************}
{                                                                    }
{           Developer Express Visual Component Library               }
{           Express Cross Platform Library classes                   }
{                                                                    }
{           Copyright (c) 2000-2008 Developer Express Inc.           }
{           ALL RIGHTS RESERVED                                      }
{                                                                    }
{   The entire contents of this file is protected by U.S. and        }
{   International Copyright Laws. Unauthorized reproduction,         }
{   reverse-engineering, and distribution of all or any portion of   }
{   the code contained in this file is strictly prohibited and may   }
{   result in severe civil and criminal penalties and will be        }
{   prosecuted to the maximum extent possible under the law.         }
{                                                                    }
{   RESTRICTIONS                                                     }
{                                                                    }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES            }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE     }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSCROSSPLATFORMLIBRARY AND ALL   }
{   ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM       }
{   ONLY.                                                            }
{                                                                    }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED       }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE         }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE        }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxImageListEditor;

{$I cxVer.inc}

interface

uses
  dxGDIPlusAPI, dxGDIPlusClasses,
  Windows, SysUtils, Classes, ImgList, ComCtrls, Controls, Graphics, Forms, Dialogs,
  cxClasses, cxGeometry, cxGraphics;

type
  TcxEditorImageInfo = class(TcxImageInfo)
  private
    FAlphaUsed: Boolean;
  protected
    procedure SetImage(Value: TBitmap); override;
  public
    property AlphaUsed: Boolean read FAlphaUsed;
  end;

  TcxImageFileFormat = record
    Name: string;
    Ext: string;
    GraphicClass: TGraphicClass;
  end;

  TcxImageFileFormatList = array of TcxImageFileFormat;

  TcxImageFileFormats = class
  private
    FList: TcxImageFileFormatList;

    function Count: Integer;
    function GetItem(Index: Integer): TcxImageFileFormat;

    property Items[Index: Integer]: TcxImageFileFormat read GetItem;
  public
    procedure Register(const AName, AExt: string; AGraphicClass: TGraphicClass);
//TODO:    procedure UnRegister(AGraphicClass: TGraphicClass);
    function GetGraphicClass(const AFileName: string): TGraphicClass;
    function GetFilter: string;
  end;

  TcxImageListEditorAddMode = (amAdd, amInsert, amReplace);

  TcxImageListEditor = class
  private
    FChanged: Boolean;
    FImageListModified: Boolean;

    FDataControl: TListView;
    FImageList: TcxImageList;
    FOriginalImageList: TcxImageList;

    FImportList: TStrings;
    FVisibleImportList: TStrings;

    FEditorForm: TForm;
    FSplitBitmaps: TModalResult;
    FUpdateCount: Integer;

    FOnChange: TNotifyEvent;

    procedure AddDataItems(AImageList: TcxImagelist);
    procedure AddImage(AImage, AMask: TBitmap; AMaskColor: TColor; var AInsertedImageIndex: Integer);
    procedure Change;
    procedure ClearSelection;
    procedure DeleteDataItem(Sender: TObject; Item: TListItem);
    procedure DeleteImage(AIndex: Integer);
    function GetImagesCount: Integer;
    function GetDataItems: TListItems;
    function GetDefaultTransparentColor(AImage, AMask: TBitmap): TColor;
    function GetFocusedImageIndex: Integer;
    function GetImageHeight: Integer;
    function GetImagesInfo(Index: Integer): TcxEditorImageInfo;
    function GetImageWidth: Integer;
    procedure ImageListChanged;
    procedure SelectDataItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure SetFocusedImageIndex(AValue: Integer);
    procedure SetImageList(AValue: TcxImageList);
    procedure SetImagesInfo(Index: Integer; AValue: TcxEditorImageInfo);
    procedure SetImportList(AValue: TStrings);

    procedure UpdateImageList;
    procedure UpdateVisibleImportList;
  public
    constructor Create;
    destructor Destroy; override;

    function Edit(AImageList: TcxImagelist): Boolean;

    procedure AddImages(AFiles: TStrings; AAddMode: TcxImageListEditorAddMode);
    procedure ClearImages;
    procedure DeleteSelectedImages;
    procedure ExportImages(const AFileName: string);
    function InternalAddImage(AImage, AMask: TBitmap; AFileName: string;
      var AInsertedItemIndex: Integer; AMultiSelect: Boolean): Integer;
    procedure ImportImages(AImageList: TCustomImageList);
    procedure MoveImage(ASourceImageIndex, ADestImageIndex: Integer);

    function IsAnyImageSelected: Boolean;

    procedure BeginUpdate;
    procedure EndUpdate;
    function IsUpdateLocked: Boolean;

    procedure ApplyChanges;
    function IsChanged: Boolean;
    procedure UpdateTransparentColor(AColor: TColor);
    function ChangeImagesSize(AValue: TSize): Boolean;
    procedure SynchronizeData(AStartIndex, ACount: Integer);

    property DataControl: TListView read FDataControl;
    property DataItems: TListItems read GetDataItems;
    property FocusedImageIndex: Integer read GetFocusedImageIndex write SetFocusedImageIndex;
    property ImageHeight: Integer read GetImageHeight;
    property ImageList: TcxImageList read FImageList write SetImageList;
    property ImageListModified: Boolean read FImageListModified;
    property ImagesCount: Integer read GetImagesCount;
    property ImagesInfo[Index: Integer]: TcxEditorImageInfo read GetImagesInfo write SetImagesInfo;
    property ImageWidth: Integer read GetImageWidth;
    property ImportList: TStrings read FImportList write SetImportList;
    property OriginalImageList: TcxImageList read FOriginalImageList;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

function cxImageFileFormats: TcxImageFileFormats;
function cxEditImageList(AImageList: TcxImageList; AImportList: TStrings): Boolean;
procedure PngImageListTocxImageList(APngImages: TComponent; AImages: TcxImageList);

implementation

uses
  Types, Math, cxImageListEditorView;

var
  FImageFileFormats: TcxImageFileFormats;

type
  TcxImageListAccess = class(TcxImageList);

  TcxIcon = class(TIcon)
  public
    procedure GetImageInfo(AImageInfo: TcxImageInfo);
    procedure HandleNeeded;
  end;

procedure TcxIcon.GetImageInfo(AImageInfo: TcxImageInfo);
var
  AImages: TcxImageListAccess;
begin
  HandleNeeded;
  AImages := TcxImageListAccess.CreateSize(Width, Height);
  try
    AImages.AddIcon(Self);
    AImages.GetImageInfo(0, AImageInfo);
  finally
    AImages.Free;
  end;
end;

procedure TcxIcon.HandleNeeded;
begin
  Handle;
end;

function cxImageFileFormats: TcxImageFileFormats;
begin
  Result := FImageFileFormats;
end;

function cxEditImageList(AImageList: TcxImageList; AImportList: TStrings): Boolean;
var
  AImageListEditor: TcxImageListEditor;
begin
  Result := False;
  if AImageList = nil then
    Exit;
  AImageListEditor := TcxImageListEditor.Create;
  try
    AImageListEditor.ImportList := AImportList;
    Result := AImageListEditor.Edit(AImageList);
  finally
    AImageListEditor.Free;
  end;
end;

function IsIndexValid(AIndex, ACount: Integer): Boolean;
begin
  Result := (AIndex >= 0) and (AIndex < ACount);
end;

function IsBitmapAlphaUsed(AImage: TBitmap): Boolean;
var
  ATempBitmap: TcxBitmap;
begin
  ATempBitmap := TcxBitmap.Create;
  ATempBitmap.Assign(AImage);
  try
    Result := ATempBitmap.IsAlphaUsed;
  finally
    ATempBitmap.Free;
  end;
end;

procedure AddImageFromBinaryData(WriteData: TStreamProc; AImages: TcxImageList);
var
  AStream: TMemoryStream;
  ACount: Longint;
  B: TBitmap;
begin
  AStream := TMemoryStream.Create;
  try
    WriteData(AStream);
    ACount := AStream.Size;
    if ACount > 0 then
    begin
      AStream.Write(AStream.Memory^, ACount);
      AStream.Position := 0;
      with TdxPNGImage.Create do
      try
        LoadFromStream(AStream);
        B := GetAsBitmap;
        try
          AImages.Add(B, nil);
        finally
          B.Free;
        end;
      finally
        Free;
      end;
    end;
  finally
    AStream.Free;
  end;
end;

procedure ProcessPngImageList(AInputSteram: TMemoryStream; AImages: TcxImageList);
var
  ASaveSeparator: Char;
  AParser: TParser;

  function ConvertOrderModifier: Integer;
  begin
    Result := -1;
    if AParser.Token = '[' then
    begin
      AParser.NextToken;
      AParser.CheckToken(toInteger);
      Result := AParser.TokenInt;
      AParser.NextToken;
      AParser.CheckToken(']');
      AParser.NextToken;
    end;
  end;

  procedure ConvertHeader(AIsInherited, AIsInline: Boolean);
  var
    AClassName, AObjectName: string;
  begin
    AParser.CheckToken(toSymbol);
    AClassName := AParser.TokenString;
    AObjectName := '';
    if AParser.NextToken = ':' then
    begin
      AParser.NextToken;
      AParser.CheckToken(toSymbol);
      AObjectName := AClassName;
      AClassName := AParser.TokenString;
      AParser.NextToken;
    end;
    ConvertOrderModifier;
  end;

  procedure ConvertProperty; forward;

  procedure ConvertValue(const APropName: string);

    procedure SkipString;
    begin
      while AParser.NextToken = '+' do
      begin
        AParser.NextToken;
        if not (AParser.Token in [toString, toWString]) then
          AParser.CheckToken(toString);
      end;
    end;

    procedure SkipBinaryData;
    var
      S: TMemoryStream;
    begin
      S := TMemoryStream.Create;
      try
        AParser.HexToBinary(S);
      finally
        S.Free;
      end;
    end;

  begin
    if AParser.Token in [toString, toWString] then
      SkipString
    else
    begin
      case AParser.Token of
        toSymbol, toInteger, toFloat:;
        '[':
          begin
            AParser.NextToken;
            if AParser.Token <> ']' then
              while True do
              begin
                if AParser.NextToken = ']' then Break;
                AParser.CheckToken(',');
                AParser.NextToken;
              end;
          end;
        '(':
          begin
            AParser.NextToken;
            while AParser.Token <> ')' do
              ConvertValue('');
          end;
        '{':
          begin
            if APropName = 'PngImage.Data' then
              AddImageFromBinaryData(AParser.HexToBinary, AImages)
            else
              SkipBinaryData;
          end;
        '<':
          begin
            AParser.NextToken;
            while AParser.Token <> '>' do
            begin
              AParser.CheckTokenSymbol('item');