lazarus/ideintf/imagelisteditor.pp
2005-09-04 08:46:52 +00:00

598 lines
14 KiB
ObjectPascal

{
*****************************************************************************
* *
* 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.