simglisteditor.pas

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

unit sImgListEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, ActnList, Buttons, ImgList, sImageList,
  ExtDlgs;

type
  TFormImgListEditor = class(TForm)
    GroupBox1: TGroupBox;
    ListView1: TListView;
    SpeedButton1: TSpeedButton;
    ActionList1: TActionList;
    ActionAdd: TAction;
    ActionDelete: TAction;
    ActionClear: TAction;
    ActionExport: TAction;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    GroupBox2: TGroupBox;
    Panel1: TPanel;
    ActionOk: TAction;
    ActionCancel: TAction;
    ActionApply: TAction;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    ImageList1: TImageList;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure ActionOkExecute(Sender: TObject);
    procedure ActionCancelExecute(Sender: TObject);
    procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ActionAddExecute(Sender: TObject);
    procedure ActionDeleteExecute(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ActionClearExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    sImageList : TsImageList;
    procedure ListViewRefresh;
    procedure InitFromImgList(ImgList : TsImageList);
  end;

var
  FormImgListEditor: TFormImgListEditor;

implementation

uses sUtils;

{$R *.DFM}

{ TFormImgListEditor }

procedure TFormImgListEditor.InitFromImgList(ImgList: TsImageList);
begin
  sImageList := ImgList;
  Caption := ImgList.Owner.Name + '.' + ImgList.GetNamePath + ' ImageList';
  ImageList1.Width := ImgList.Width;
  ImageList1.Height := ImgList.Height;
  ImageList1.Assign(ImgList);
  ListViewRefresh;
end;

procedure TFormImgListEditor.ActionOkExecute(Sender: TObject);
begin
  if Assigned(sImageList) then sImageList.Assign(ImageList1);
  Close;
end;

procedure TFormImgListEditor.ActionCancelExecute(Sender: TObject);
begin
  Close;
end;

procedure TFormImgListEditor.ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  li : TListItem;
begin
  li := ListView1.GetItemAt(X, Y);
  Accept := (li <> nil) and (li <> ListView1.ItemFocused);
end;

procedure TFormImgListEditor.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  li : TListItem;
begin
  li := ListView1.GetItemAt(X, Y);
  ImageList1.Move(ListView1.ItemFocused.Index, li.Index);
end;

procedure TFormImgListEditor.ActionAddExecute(Sender: TObject);
var
  s : string;
  SourceBmp, TempBmp : TBitmap;
begin
  if OpenPictureDialog1.Execute then begin
    s := UpperCase(ExtractWord(2, OpenPictureDialog1.FileName, ['.']));
    if s = 'BMP' then begin
      SourceBmp := TBitmap.Create;
      try
      SourceBmp.LoadFromFile(OpenPictureDialog1.FileName);
      if (Sourcebmp.Width <> ImageList1.Width) and
           (Sourcebmp.Width mod ImageList1.Width = 0) and
             (Sourcebmp.Height <> ImageList1.Height) and
               (Sourcebmp.Height mod ImageList1.Height = 0) and
                 CustomRequest('Format dimensions for ' + OpenPictureDialog1.FileName + 
                                  ' are greater than imagelist dimensions. Separate into ' +
                                     IntToStr((Sourcebmp.Width div ImageList1.Width) * (Sourcebmp.Height div ImageList1.Height)) + ' separate bitmaps?') then begin
//          d;lj;lwdjf;l!!!
      end
      else begin
        if (Sourcebmp.Width = ImageList1.Width) and (Sourcebmp.Height = ImageList1.Height) then begin
          ImageList1.Add(SourceBmp, nil);
        end
        else begin
          TempBmp := TBitmap.Create;
          TempBmp.PixelFormat := SourceBmp.PixelFormat;
          TempBmp.Width := ImageList1.Width;
          TempBmp.Height := ImageList1.Height;
          StretchBlt(TempBmp.Canvas.Handle, 0, 0, Tempbmp.Width, Tempbmp.Height, SourceBmp.Canvas.Handle, 0, 0, SourceBmp.Width, SourceBmp.Height, SRCCOPY);
          ImageList1.Add(TempBmp, nil);
          FreeAndNil(TempBmp);
        end;
      end;

      finally
      FreeAndNil(SourceBmp);
      end;
      ListViewRefresh;
    end
    else
    if s = 'ICO' then begin
      ImageList1.FileLoad(rtIcon, OpenPictureDialog1.FileName, clNone);
    end
    else ShowError('Unknown file format');
  end;
end;

procedure TFormImgListEditor.ListViewRefresh;
var
  i : integer;
begin
  ListView1.Items.Clear;
  for i := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add;
    ListView1.Items.Item[i].ImageIndex := i;
    ListView1.Items.Item[i].Caption := IntToStr(i);
  end;
  ActionClear.Enabled := ImageList1.Count > 0;
end;

procedure TFormImgListEditor.ActionDeleteExecute(Sender: TObject);
begin
  ImageList1.Delete(ListView1.ItemFocused.Index);
  ListViewRefresh;
end;

procedure TFormImgListEditor.ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  ActionDelete.Enabled := ListView1.Selected <> nil;
  ActionClear.Enabled := ImageList1.Count > 0;
end;

procedure TFormImgListEditor.ActionClearExecute(Sender: TObject);
begin
  while ImageList1.Count > 0 do begin
    ImageList1.Delete(0);
  end;
  ListViewRefresh;
  ActionClear.Enabled := False;
end;

procedure TFormImgListEditor.FormShow(Sender: TObject);
begin
  if Height = 345 then Height := 370 + ImageList1.Height;
end;

end.