lazarus/ideintf/imagelisteditor.pp

{
 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

@author(Olivier guilbaud (OG) <golivier@free.fr>)
@created(24/02/2003)
@lastmod(25/02/2003)

Property editor for TImageList objects

History
 26-Feb-2003 OG - Update for use assign.
 27-feb-2003 OG - If possible zoom x2 the selected image.
                - Fix the superposition of images
 
Todo :
  - Rogne and truncate image capability
}

unit ImageListEditor;

{$MODE OBJFPC}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, LResources, ComCtrls,
  StdCtrls, Buttons, ExtCtrls, Menus, PropEdits, ComponentEditors, LCLProc,
  ObjInspStrConsts;

const
  //See @link  TGraphicPropertyEditorForm.LoadBTNCLICK for explanations
  FormatsSupported: Array[0..1] of String =('.xpm',
                                             '.bmp');

Type
  { TImageListEditorDlg }

  Directions = (Up,Down);
  
  //Editor dialog
  TImageListEditorDlg = Class(TForm)
  private
    fImg: TImage;
    fLv : TListView;
    fImgL: TImageList;
    fBtnAdd  : TButton;
    fBtnDel  : TButton;
    fBtnClear: TButton;
    fBtnMoveUp   : TButton;
    fBtnMoveDown : TButton;
    fDirName : String;
    FModified: boolean;
    FmnuLVPopupAdd : TMenuItem;
    FmnuLVPopupDelete : TMenuItem;
    FmnuLVPopupClear : TMenuItem;
    FmnuLVPopupMoveUp : TMenuItem;
    FmnuLVPopupMoveDown : TMenuItem;
    
    procedure OnLVLSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure OnClickAdd(Sender: TObject);
    procedure OnClickDel(Sender: TObject);
    procedure OnClickClear(Sender: TObject);
    procedure OnClickMoveUp(Sender: TObject);
    procedure OnClickMoveDown(Sender: TObject);
    procedure SetModified(const AValue: boolean);
    procedure MoveImageIndex(Direction : Directions);
    procedure AddImageToList(FileName: string);
  public
    mnuLVPopup : TPopupMenu;
    constructor Create(aOwner: TComponent); override;

    //Assign an List images at editor and initialise the
    //TListView component
    Procedure AssignImageList(aImgL: TImageList);
    property Modified: boolean read FModified write SetModified;
  end;

  //Editor call by Lazarus with 1 verbe only
  TImageListComponentEditor = class(TDefaultComponentEditor)
  protected
    procedure DoShowEditor;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

Implementation

//If Select item, preview the image
procedure TImageListEditorDlg.OnLVLSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
Var Bmp: TBitMap;
begin
  if Assigned(Item) and Selected then
  begin
    if (Item.ImageIndex>=0) then
    begin
      //Clear old image
      fImg.Picture.BitMap.Canvas.Brush.Color:=clWhite;
      fImg.Picture.BitMap.Canvas.FillRect(Rect(0,0,fImg.Width,fImg.Height));

      //Draw new image
      Bmp:=TBitMap.Create;
      fImgL.GetBitmap(Item.ImageIndex,Bmp);

      fImg.Picture.BitMap:=Bmp;
      Bmp.Free;

      fBtnDel.Enabled:=True;
      fImg.Visible:=True;
      fBtnClear.Enabled:=True;
      fImg.Invalidate;
    end;
  end;
end;

procedure TImageListEditorDlg.AddImageToList(FileName: string);
var Ext: string;
    i: integer;
    Bmp: TBitmap;
    AListItem: TListItem;
begin
  Ext:=ExtractFileExt(FileName);
  //Check if the file is supported
  for i:=Low(FormatsSupported) to High(FormatsSupported) do
  begin
    if AnsiCompareText(Ext,FormatsSupported[i]) = 0 then
    begin
      fImg.Picture.LoadFromFile(FileName);
      Break;
    end;
  end;
  //If the image is loaded, then add to list
  if Assigned(fImg.Picture.Graphic) then
  begin
    if not fImg.Picture.Graphic.Empty then
    begin
      Bmp:=TBitMap.Create;
      Bmp.LoadFromFile(FileName);
      Modified:=true;
      i:=fImgL.Add(Bmp,nil);
      AListItem:=fLV.Items.Add;
      AListItem.Caption:=IntToStr(i);
      AListItem.ImageIndex:=i;
      fLV.Selected:=AListItem;
    end;
  end;
end;

//Select new image file and add in list
procedure TImageListEditorDlg.OnClickAdd(Sender: TObject);
Var OpenDlg: TOpenDialog;
    FileName: String;
    i      : Integer;
begin
 Opendlg := TOpenDialog.Create(Self);
 Try
   Opendlg.Options:=[ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofEnableSizing, ofAllowMultiSelect];
   Opendlg.Filter:='All supported files (*.xpm;*.bmp)|*.xpm;*.bmp|'+
                   'Pixmap (*.xpm)|*.xpm|Bitmap (*.bmp)|*.bmp';
   OpenDlg.InitialDir:=fDirName; //last directory
   
   If OpenDlg.Execute then
   begin
     fDirName:=ExtractFilePath(FileName); //save the directory
     FileName:=OpenDlg.FileName;
     for i := 0 to OpenDlg.Files.Count - 1 do
       AddImageToList(OpenDlg.Files[i]);
   end;
 finally
   OpenDlg.Free;
 end;
end;

//Delete the selected image and refresh screen
procedure TImageListEditorDlg.OnClickDel(Sender: TObject);
Var IL : TListItem;
    i,j: Integer;
begin
  If Assigned(fLV.Selected) then
  begin
    Modified:=true;
    fImgL.Delete(fLV.Selected.ImageIndex);
    IL:=flv.Selected;
    i:=Il.Index;
    fLv.Items.Delete(Il.Index);
    
    //Select an new item
    if (fLv.Items.Count<>0) then
    begin
      for j:=i to fLv.Items.Count-1 do
      begin
        fLv.Items.Item[j].ImageIndex:=fLv.Items.Item[j].ImageIndex-1;
        fLv.Items.Item[j].Caption:=IntToStr(fLv.Items.Item[j].ImageIndex);
      end;
      
      if i>fLv.Items.Count-1 then
        Dec(i);
        
      Il:=fLv.Items.Item[i];
      fLv.Selected:=IL;
    end
    else
    begin
      fBtnDel.Enabled:=False;
      fImg.Visible:=False;
      fBtnClear.Enabled:=False;
    end;
  end;
end;

//Delete all images of list  and items for TListView
procedure TImageListEditorDlg.OnClickClear(Sender: TObject);
begin
  if (fImgL.Count>0)
  and (MessageDlg(sccsILConfirme,mtConfirmation,[mbYes,mbNo],0)=mrYes) then
  begin
    Modified:=true;
    fImgL.Clear;
    while fLV.Items.Count<>0 do
      fLV.Items.Delete(0);
    fBtnDel.Enabled:=False;
    fBtnClear.Enabled:=False;
    fImg.Visible:=False;
  end;
end;

procedure TImageListEditorDlg.OnClickMoveDown(Sender: TObject);
begin
  MoveImageIndex(Down);
end;

procedure TImageListEditorDlg.OnClickMoveUp(Sender: TObject);
begin
  MoveImageIndex(Up);
end;
  
procedure TImageListEditorDlg.SetModified(const AValue: boolean);
begin
  if FModified=AValue then exit;
  FModified:=AValue;
end;

{ TImageListEditorDlg }
constructor TImageListEditorDlg.Create(aOwner: TComponent);
Var Cmp: TWinControl;
begin
  inherited Create(aOwner);
  BorderStyle:=bssingle;
  
  //Temporary list
  fImgL:=TImageList.Create(self);

  //Default directory
  fDirName:=ExtractFilePath(ParamStr(0));
  
  //Sise of window
  Height:=331;
  Width :=579;
  BorderStyle:=bsSingle;
  Position :=poScreenCenter;
  Caption  :=sccsILEdtCaption;
  
  //Bnt Ok
  With TBitBtn.Create(self) do
  begin
    Left  :=448;
    Width :=99;
    Top   :=16;
    Kind  :=bkOk;
    Parent:=self;
  end;

  //Bnt Cancel
  With TBitBtn.Create(self) do
  begin
    Left  :=448;
    Width :=99;
    Top   :=56;
    Kind  :=bkCancel;
    Parent:=self;
  end;

  //Top group box
  Cmp:=TGroupBox.Create(self);
  With TgroupBox(Cmp) do
  begin
    Width  :=416;
    Top    :=6;
    Left   :=8;
    Height :=130;
    Parent :=Self;
    Caption:=sccsILCmbImgSel
  end;

  //TShape for best view
  with TShape.Create(self) do
  begin
    Parent      :=Cmp;
    Left        :=11;
    Width       :=98;
    Top         :=6;
    Height      :=98;
  end;

  //Image for preview a selected image item
  fImg:=TImage.Create(self);
  With fImg do
  begin
    Parent      :=Cmp;
    Transparent :=False;
    Left        :=12;
    Width       :=97;
    Top         :=7;
    Height      :=97;
  end;

  //bottom group box
  Cmp:=TGroupBox.Create(self);
  With TgroupBox(Cmp) do
  begin
    Width  :=562;
    Top    :=144;
    Left   :=8;
    Height :=180;
    Parent :=Self;
    Caption:=sccsILCmbImgList
  end;

  fLV :=TListView.Create(self);
  With fLV do
  begin
    Parent :=Cmp;
    Left   :=3;
    Width  :=411;
    Top    :=1;
    Height :=160;
    SmallImages:=fImgL;
    ScrollBars:=sshorizontal;
    fLV.OnSelectItem:=@OnLVLSelectItem;
  end;

  fBtnAdd:=TButton.Create(self);
  With fBtnAdd do
  begin
    Parent  :=Cmp;
    Top     :=1;
    Width   :=112;
    Left    :=430;
    Height  :=25;
    Caption :=sccsILBtnAdd;
    OnClick :=@OnClickAdd;
  end;

  fBtnDel:=TButton.Create(self);
  With fBtnDel do
  begin
    Parent  :=Cmp;
    Top     :=34;
    Width   :=112;
    Left    :=430;
    Height  :=25;
    Enabled :=False;
    Caption :=sccsLvEdtBtnDel; //Same caption
    OnClick :=@OnClickDel;
  end;

  fBtnClear:=TButton.Create(self);
  With fBtnClear do
  begin
    Parent  :=Cmp;
    Top     :=66;
    Width   :=112;
    Left    :=430;
    Height  :=25;
    Enabled :=False;
    Caption :=sccsILBtnClear;
    OnClick :=@OnClickClear;
  end;
  
  fBtnMoveUp:=TButton.Create(self);
  With fBtnMoveUp do
  begin
    Parent  :=Cmp;
    Top     :=98;
    Width   :=112;
    Left    :=430;
    Height  :=25;
    //Enabled :=False;
    Enabled :=True;
    //Caption :=sccsILBtnClear;
    Caption := cActionListEditorMoveUpAction;
    OnClick := @OnClickMoveUp;
  end;

  fBtnMoveDown:=TButton.Create(self);
  With fBtnMoveDown do
  begin
    Parent  :=Cmp;
    Top     :=130;
    Width   :=112;
    Left    :=430;
    Height  :=25;
    //Enabled :=False;
    Enabled :=True;
    //Caption :=sccsILBtnClear;
    Caption := cActionListEditorMoveDownAction;
    OnClick := @OnClickMoveDown;
  end;

  FmnuLVPopupAdd := TMenuItem.Create(Self);
  With FmnuLVPopupAdd do
  begin
    Caption := ilesAdd;
    OnClick := @OnClickAdd;
  end;
  
  FmnuLVPopupDelete := TMenuItem.Create(Self);
  With FmnuLVPopupDelete do
  begin
    Caption := oisDelete;
    OnClick := @OnClickDel;
  end;

  FmnuLVPopupClear := TMenuItem.Create(Self);
  With FmnuLVPopupClear do
  begin
    Caption := sccsILBtnClear;
    OnClick := @OnClickClear;
  end;

  FmnuLVPopupMoveUp := TMenuItem.Create(Self);
  With FmnuLVPopupMoveUp do
  begin
    Caption := cActionListEditorMoveUpAction;
    OnClick := @OnClickMoveUp;
  end;

  FmnuLVPopupMoveDown := TMenuItem.Create(Self);
  With FmnuLVPopupMoveDown do
  begin
    Caption := cActionListEditorMoveDownAction;
    OnClick := @OnClickMoveDown;
  end;

  mnuLVPopup := TPopupMenu.Create(Self);
  With mnuLVPopup do
  begin
    Items.Add(FmnuLVPopupAdd);
    Items.Add(FmnuLVPopupDelete);
    Items.Add(FmnuLVPopupClear);
    Items.Add(FmnuLVPopupMoveUp);
    Items.Add(FmnuLVPopupMoveDown);
  end;

  fLV.PopupMenu := mnuLVPopup;
end;

//Assign an List images at editor
procedure TImageListEditorDlg.AssignImageList(aImgL: TImageList);
Var IL: TListItem;
    i : Integer;
begin
  If Assigned(aImgL) then
  begin
    //Clear all existing images
    fImgL.Clear;
    while fLV.Items.Count<>0 do
      fLV.Items.Delete(0);

    fImgL.Assign(aImgL);

    for i:=0 to fImgL.Count-1 do
    begin
      IL:=fLV.Items.Add;
      Il.ImageIndex:=i;
      IL.Caption:=IntToStr(i);
    end;
    
    //If possible zoom the selected image
    if (fImgL.Width<97) and (fImgL.Height<97) then
    begin
      fImg.Width  :=fImgL.Width;
      fImg.Height :=fImgL.Height;
      fImg.Stretch:=false;// scaling is not yet supported for transparent images

      //Center the image
      fImg.Left:=12+(97-fImg.Width);
      fImg.Top := 7+(97-fImg.Height);
    end
    else
    begin
      //Restore the default position
      fImg.Width  :=97;
      fImg.Height :=97;
      fImg.Top    :=7;
      fImg.Left   :=12;
      fImg.Stretch:=false;// scaling is not yet supported for transparent images
    end;
    
    fBtnDel.Enabled:=(fImgL.Count<>0);
    fBtnClear.Enabled:=(fImgL.Count<>0);
    fImg.Visible:=(fImgL.Count<>0);
    //Select the first item
    if (fImgL.Count<>0) then
      fLV.Selected:=fLV.Items.Item[0];

  end;
end;

procedure TImageListEditorDlg.MoveImageIndex(Direction : Directions);
var
  iSelected : Integer;
begin
  //sanity check
  if fLv.Selected <> nil then
  begin
    if (Direction = Up) and (fLv.Selected.Index > 0 ) then
    begin
      iSelected := fLv.Selected.Index;
      fImgL.Move(iSelected,iSelected-1);
      fLv.Selected := fLv.Items[iSelected - 1];
      Modified := True;
    end else if (Direction = Down) and (fLv.Selected.Index < (fLv.Items.Count-1)) then
    begin
      fImgL.Move(fLv.Selected.Index,fLv.Selected.Index+1);
      fLv.Selected := fLv.Items[fLv.Selected.Index + 1];
      Modified := True;
    end;
  end;
end;

{ TImageListComponentEditor }

procedure TImageListComponentEditor.DoShowEditor;
Var Dlg: TImageListEditorDlg;
    Hook: TPropertyEditorHook;
    aImg: TImageList;
begin
  Dlg:=TImageListEditorDlg.Create(nil);
  try
    If GetComponent is TImageList then
    begin
      aImg:=TImageList(GetComponent);
      GetHook(Hook);
      Dlg.AssignImageList(aImg);

      //ShowEditor
      if (Dlg.ShowModal=mrOK) and Dlg.Modified then
      begin
      
        //Apply the modifications
        DebugLn('TImageListComponentEditor.DoShowEditor A %d %d,%d',
          [aImg.Count,aImg.Width,aImg.Height]);
        aImg.Assign(Dlg.fImgL);
        DebugLn('TImageListComponentEditor.DoShowEditor B %d %d,%d',
          [aImg.Count,aImg.Width,aImg.Height]);

        //not work :o( aImg.AddImages(Dlg.fImgL);
        if Assigned(Hook) then
          Hook.Modified(Self);
      end;
    end;
  finally
    Dlg.Free;
  end;
  DebugLn('TImageListComponentEditor.DoShowEditor END ');
end;

procedure TImageListComponentEditor.ExecuteVerb(Index: Integer);
begin
  DoShowEditor;
end;

function TImageListComponentEditor.GetVerb(Index: Integer): string;
begin
  Result:=sccsILEdtCaption+' ...';
end;

function TImageListComponentEditor.GetVerbCount: Integer;
begin
  Result:=1;
end;

initialization
  //Register a component editor for TImageList
  RegisterComponentEditor(TImageList,TImageListComponentEditor);
end.