paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 02:00:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

added imagelisteditor from Olivier

Browse Source 
git-svn-id: trunk@3876 -
This commit is contained in:
mattias 2003-02-26 23:31:53 +00:00
parent ae1de60c60
commit e42ba0e116
6 changed files with 620 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -146,6 +146,7 @@ designer/designermenu.pp svneol=native#text/pascal
designer/designerprocs.pas svneol=native#text/pascal
designer/filesystem.pp svneol=native#text/pascal
designer/graphpropedits.pas svneol=native#text/pascal
designer/imagelisteditor.pp svneol=native#text/pascal
designer/jitform/jitform.pas svneol=native#text/pascal
designer/jitforms.pp svneol=native#text/pascal
designer/listviewpropedit.pp svneol=native#text/pascal

445
designer/imagelisteditor.pp Normal file
View File

@ -0,0 +1,445 @@
{
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code 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. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
{
@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.
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,
LMessages, ObjInspStrConsts,ImgList;
const
//See @link TGraphicPropertyEditorForm.LoadBTNCLICK for explanations
FormatsSupported : Array[0..1] of String =('.xpm',
'.bmp');
Type
{TMenuItemsPropertyEditorDlg}
//Editor dialog
TImageListEditorDlg = Class(TForm)
private
fImg : TImage;
fLv : TListView;
fImgL: TImageList;
fBtnAdd : TButton;
fBtnDel : TButton;
fBtnClear : TButton;
fDirName : String;
procedure OnLVLSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
procedure OnClickAdd(Sender : TObject);
procedure OnClickDel(Sender : TObject);
procedure OnClickClear(Sender : TObject);
public
constructor Create(aOwner : TComponent); override;
//Assign an List images at editor and initialise the
//TListView component
Procedure AssignImageList(aImgL : TImageList);
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<>-1) then
begin
Bmp:=TBitMap.Create;
Try
Bmp.Width :=fImgL.Width;
Bmp.Height:=fImgL.Height;
Bmp.Canvas.Brush.Color:=clWhite;
Bmp.Canvas.FillRect(0,0,Bmp.Width,Bmp.Height);
fImgL.GetBitmap(Item.ImageIndex,Bmp);
fImg.Picture.Assign(nil);
fImg.Picture.BitMap.Assign(Bmp);
fBtnDel.Enabled:=True;
fImg.Visible:=True;
fBtnClear.Enabled:=True;
finally
Bmp.Free;
end;
end;
end;
end;
//Select new image file and add in list
procedure TImageListEditorDlg.OnClickAdd(Sender: TObject);
Var OpenDlg : TOpenDialog;
Ext : String;
FileName: String;
IL : TListItem;
i : Integer;
Bmp : TBitMap;
begin
Opendlg := TOpenDialog.Create(Self);
Try
Opendlg.Options:=[ofextensiondifferent, ofpathmustexist, offilemustexist, ofenablesizing];
Opendlg.DefaultExt:='.xpm';
Opendlg.Filter:='*.xpm';
OpenDlg.InitialDir:=fDirName; //last rirectory
If OpenDlg.Execute then
begin
FileName:=OpenDlg.FileName;
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);
fDirName:=ExtractFilePath(FileName); //save the directory
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);
i:=fImgL.Add(Bmp,nil);
IL:=fLV.Items.Add;
Il.Caption:=IntToStr(i);
IL.ImageIndex:=i;
fLV.Selected:=IL;
end;
end;
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
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 MessageDlg(sccsILConfirme,mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
fImgL.Clear;
while fLV.Items.Count<>0 do
fLV.Items.Delete(0);
fBtnDel.Enabled:=False;
fBtnClear.Enabled:=False;
fImg.Visible:=False;
end;
end;
{ TImageListEditorDlg }
constructor TImageListEditorDlg.Create(aOwner: TComponent);
Var Cmp : TWinControl;
begin
inherited Create(aOwner);
//Temporary list
fImgL:=TImageList.Create(self);
//Default directory
fDirName:=ExtractFilePath(ParamStr(0));
//Sise of window
Height:=289;
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 :=141;
Parent :=Self;
Caption:=sccsILCmbImgList
end;
fLV :=TListView.Create(self);
With fLV do
begin
Parent :=Cmp;
Left :=3;
Width :=411;
Top :=1;
Height :=118;
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;
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.Width:=aImgL.Width;
fImgL.Height:=aImgL.Height;
fImgL.Assign(aImgL);
for i:=0 to fImgL.Count-1 do
begin
IL:=fLV.Items.Add;
Il.ImageIndex:=i;
IL.Caption:=IntToStr(i);
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;
{ TImageListComponentEditor }
procedure TImageListComponentEditor.DoShowEditor;
Var Dlg : TImageListEditorDlg;
Hook: TPropertyEditorHook;
aImg: TImageList;
begin
Dlg:=TImageListEditorDlg.Create(Application);
try
If GetComponent is TImageList then
begin
aImg:=TImageList(GetComponent);
GetHook(Hook);
Dlg.AssignImageList(aImg);
//ShowEditor
if Dlg.ShowModal=mrOK then
begin
//Apply the modifications
aImg.Assign(Dlg.fImgL);
//not work :o( aImg.AddImages(Dlg.fImgL);
if Assigned(Hook) then
Hook.Modified;
end;
end;
finally
Dlg.Free;
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.

2
designer/objectinspector.pp
View File

@ -35,7 +35,7 @@ uses
Forms, SysUtils, Buttons, Classes, Graphics, GraphType, StdCtrls, LCLType,
LCLLinux, LMessages, Controls, ComCtrls, ExtCtrls, TypInfo, Messages,
LResources, Laz_XMLCfg, Menus, Dialogs, ObjInspStrConsts,
PropEdits, GraphPropEdits, ListViewPropEdit;
PropEdits, GraphPropEdits, ListViewPropEdit,ImageListEditor;
type

10
designer/objinspstrconsts.pas
View File

@ -37,7 +37,15 @@ resourcestring
sccsLvEdtBtnAdd = 'New';
sccsLvEdtBtnDel = 'Delete';
sccsLvEdtBtnAddSub = 'Sub item';
//Image editor strings
sccsILEdtCaption = 'Image list editor';
sccsILCmbImgSel = ' Selected image ';
sccsILCmbImgList = ' Images ';
sccsILBtnAdd = 'Add ...';
sccsILBtnClear = 'Clear';
sccsILConfirme = 'Confirme clear all images ?';
implementation
end.

28
lcl/imglist.pp
View File

@ -26,9 +26,18 @@
@author(TCustomImageList - Marc Weustink <weus@quicknet.nl>)
@author(TChangeLink - Marc Weustink <weus@quicknet.nl>)
@created(16-Aug-1999)
@lastmod(26-Sep-1999)
@lastmod(26-feb-2003)
Detailed description of the Unit.
History
26-feb-2003 Olivier Guilbaud <golivier@free.fr>
- Add TCustomImageList.Assign()
- Add TCustomImageList.WriteData()
- Add TCustomImageList.ReadData()
- Add overrite TCustomImageList.DefineProperties()
Warning : the delphi or kylix format of datas is not compatible.
- Modify Delete and Clear for preserve memory
}
unit ImgList;
@ -112,7 +121,12 @@ type
protected
procedure GetImages(Index: Integer; const Image, Mask: TBitmap);
procedure Initialize; virtual;
procedure DefineProperties(Filer: TFiler); override;
public
procedure Assign(Source: TPersistent); override;
procedure WriteData(Stream: TStream); virtual;
procedure ReadData(Stream : TStream); virtual;
function Add(Image, Mask: TBitmap): Integer;
function AddIcon(Image: TIcon): Integer;
procedure AddImages(Value: TCustomImageList);
@ -138,6 +152,7 @@ type
procedure ReplaceIcon(Index: Integer; Image: TIcon);
procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
procedure UnRegisterChanges(Value: TChangeLink);
property AllocBy: Integer read FAllocBy write FAllocBy default 4;
property BlendColor: TColor read FBlendColor write FBlendColor default clNone;
property BkColor: TColor read FBkColor write SetBkColor default clNone;
@ -156,7 +171,15 @@ type
end;
{ TImageList }
{ TImageList = class(TCustomImageList)
published
Property Height;
Property Width;
end;
}
implementation
uses dialogs;
{$I imglist.inc}
@ -164,6 +187,9 @@ end.
{
$Log$
Revision 1.10 2003/02/26 23:31:53 mattias
added imagelisteditor from Olivier
Revision 1.9 2002/12/16 12:12:50 mattias
fixes for fpc 1.1

144
lcl/include/imglist.inc
View File

@ -201,6 +201,8 @@ end;
------------------------------------------------------------------------------}
procedure TCustomImageList.Clear;
begin
While Count<>0 do
Delete(0);
FCount := 0;
FImageList.Clear;
Change;
@ -247,18 +249,23 @@ end;
Deletes the image identified by Index. An index of -1 deletes all
------------------------------------------------------------------------------}
procedure TCustomImageList.Delete(Index: Integer);
Var Obj : TObject;
begin
if {(Index < 0) or} (Index >= FCount) // !! Delphi4 has no check for < -1
then raise EInvalidOperation.Create(SInvalidIndex);
if Index = -1
then Clear
else begin
if Index = -1 then
Clear
else
begin
Obj:=TObject(fImageList.Items[Index]);
If Assigned(Obj) then
Obj.Free;
fImageList.Items[Index]:=nil;
fImageList.Pack;
// ShiftImages(FBitmap.Canvas, Index, 1);
// ShiftImages(FMaskBitmap.Canvas, Index, 1);
FImageList.Delete(Index); //shane
Change;
Change;
end;
end;
@ -312,13 +319,30 @@ end;
Fetches the index'th image into a bitmap.
------------------------------------------------------------------------------}
procedure TCustomImageList.GetBitmap(Index: Integer; Image: TBitmap);
Var Stream : TMemoryStream;
aBmp : TbitMap;
begin
if (FCount = 0) or (Image = nil) then Exit;
with Image do begin
aBmp:=TBitMap(self.FImageList.Items[Index]);
if Assigned(aBmp) then
begin
Stream:=TMemoryStream.Create;
try
aBmp.SaveToStream(Stream);
Stream.Position:=0;
Image.LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
{with Image do
begin
Width := FWidth;
Height := FHeight;
Self.Draw(Canvas, 0, 0, Index, True);
end;
}
end;
{------------------------------------------------------------------------------
@ -445,6 +469,109 @@ begin
end;
end;
Type
THackBitMap = Class(TBitMap)
public
procedure ReadData(Stream : TStream);
procedure WriteData(Stream : TStream);
end;
procedure THackBitMap.ReadData(Stream : TStream);
begin
Inherited ReadData(Stream);
end;
procedure THackBitMap.WriteData(Stream : TStream);
begin
Inherited WriteData(Stream);
end;
procedure TCustomImageList.DefineProperties(Filer: TFiler);
function DoWrite: Boolean;
begin
{ if Filer.Ancestor <> nil then
begin
Result := (not (Filer.Ancestor is TCustomImageList) or
not Equal(TCustomImageList(Filer.Ancestor)));
end
else
}
Result := Count > 0;
end;
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Bitmap', @ReadData, @WriteData, DoWrite);
end;
//Very simple assign with stream exchange
procedure TCustomImageList.Assign(Source: TPersistent);
Var Stream : TMemoryStream;
ImgSrc : TCustomImageList;
begin
If Source is TCustomImageList then
begin
ImgSrc:=TCustomImageList(Source);
If (Width=ImgSrc.Width) and (Height=ImgSrc.Height) then
begin
Clear;
Stream:=TMemoryStream.Create;
try
ImgSrc.WriteData(Stream);
Stream.Position:=0;
ReadData(Stream);
finally
Stream.Free;
end;
end;
end
else inherited Assign(Source);
end;
procedure TCustomImageList.WriteData(Stream: TStream);
Var Bmp : THackBitMap;
i : Integer;
begin
//Write signature
Stream.WriteWord($0001);
//Count of image
Stream.WriteWord(Count);
for i:=0 to Count-1 do
begin
Bmp:=THackBitMap.Create;
Bmp.Width:=Width;
Bmp.Height:=Height;
Try
GetBitmap(i,Bmp);
Bmp.WriteData(Stream);
finally
Bmp.Free;
end;
end;
end;
procedure TCustomImageList.ReadData(Stream: TStream);
Var Bmp : THackBitMap;
i : LongInt;
Sign,Nb : Word;
begin
Sign:=Stream.ReadWord;
if Sign=$0001 then
begin
Nb:=Stream.ReadWord;
for i:=0 to Nb-1 do
begin
Bmp:=THackBitMap.Create;
Bmp.ReadData(Stream);
Bmp.Transparent:=True;
Add(Bmp,nil);
end;
end;
end;
{------------------------------------------------------------------------------
Method: TCustomImageList.Insert
Params: Index: the index of the inserted image
@ -854,6 +981,9 @@ end;
{
$Log$
Revision 1.15 2003/02/26 23:31:53 mattias
added imagelisteditor from Olivier
Revision 1.14 2002/12/16 12:12:50 mattias
fixes for fpc 1.1