paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-13 11:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

Added TImage class

Browse Source 
Shane

git-svn-id: trunk@554 -
This commit is contained in:
lazarus 2001-12-21 18:17:00 +00:00
parent b036c95a80
commit ea61035ca8
13 changed files with 145 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -209,6 +209,7 @@ images/components/tibdatabase.ico -text svneol=native#image/x-icon
images/components/tibdatabase.xpm -text svneol=native#image/x-xpixmap
images/components/tibquery.ico -text svneol=native#image/x-icon
images/components/tibquery.xpm -text svneol=native#image/x-xpixmap
images/components/timage.xpm -text svneol=native#image/x-xpixmap
images/components/tlabel.ico -text svneol=unset#image/x-icon
images/components/tlabel.xpm -text svneol=native#image/x-xpixmap
images/components/tlistbox.ico -text svneol=unset#image/x-icon
@ -372,6 +373,7 @@ lcl/include/graphiccontrol.inc svneol=native#text/pascal
lcl/include/graphicsobject.inc svneol=native#text/pascal
lcl/include/hintwindow.inc svneol=native#text/pascal
lcl/include/hkeys.inc svneol=native#text/pascal
lcl/include/image.inc svneol=native#text/pascal
lcl/include/imglist.inc svneol=native#text/pascal
lcl/include/interfacebase.inc svneol=native#text/pascal
lcl/include/listitem.inc svneol=native#text/pascal

2
ide/idecomp.pp
View File

@ -303,7 +303,7 @@ begin
,TListBox,TRadioButton,TComboBox,TScrollBar,TGroupBox,TToggleBox]);
RegisterComponents('Additional','Buttons',[TBitBtn,TSpeedButton]);
RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox
,TBevel,TRadioGroup]);
,TBevel,TRadioGroup,TImage]);
RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView
,TProgressBar,TToolBar,TTrackbar]);

28
images/components/timage.xpm Normal file
View File

@ -0,0 +1,28 @@
/* XPM */
static char *timage[]={
"20 20 5 1",
"c c #0058c0",
"b c #008000",
". c #a8dcff",
"# c #ffff00",
"a c #ffffff",
"....................",
"....................",
".#....#.............",
"..#..#......a.a.aa..",
"...##.......a..a..a.",
"...##........a.aa...",
"..#..#............a.",
".#....#.............",
"....................",
"....................",
"....................",
"...................b",
"..................bb",
"cccccccccccccccccbbb",
"ccccccccccccccccbbbb",
"cccccccccccccccbbbbb",
"ccccccccccccccbbbbbb",
"cccccccccccccbbbbbbb",
"ccccccccccccbbbbbbbb",
"cccccccccccbbbbbbbbb"};

12
images/components_images.lrs
View File

@ -571,6 +571,18 @@
+' N ",'#10'"N N N N N N N N N N N N N ",'#10'" '
+' N "};'#10
);
LazarusResources.Add('timage','XPM',
'/* XPM */'#10'static char *timage[]={'#10'"20 20 5 1",'#10'"c c #0058c0",'
+#10'"b c #008000",'#10'". c #a8dcff",'#10'"# c #ffff00",'#10'"a c #ffffff'
+'",'#10'"....................",'#10'"....................",'#10'".#....#.'
+'............",'#10'"..#..#......a.a.aa..",'#10'"...##.......a..a..a.",'
+#10'"...##........a.aa...",'#10'"..#..#............a.",'#10'".#....#.....'
+'........",'#10'"....................",'#10'"....................",'#10'"'
+'....................",'#10'"...................b",'#10'"................'
+'..bb",'#10'"cccccccccccccccccbbb",'#10'"ccccccccccccccccbbbb",'#10'"cccc'
+'cccccccccccbbbbb",'#10'"ccccccccccccccbbbbbb",'#10'"cccccccccccccbbbbbbb'
+'",'#10'"ccccccccccccbbbbbbbb",'#10'"cccccccccccbbbbbbbbb"};'#10
);
LazarusResources.Add('tlabel','XPM',
'/* XPM */'#10'static char * tlabel_xpm[] = {'#10'"17 12 35 1",'#10'" '#9
+'c None",'#10'".'#9'c #000000",'#10'"+'#9'c #030303",'#10'"@'#9'c #060606'

10
lcl/comctrls.pp
View File

@ -382,6 +382,8 @@ type
FSubItems: TStrings;
//FIndex : Integer;
FCaption : String;
FImageIndex: Integer;
procedure SetImageIndex(const AValue: Integer);
Procedure SetCaption(const Value : String);
// Procedure SetSubItems(Value : TStrings);
Function GetIndex : Integer;
@ -396,6 +398,7 @@ type
property Index : Integer read GetIndex;
property Owner : TListItems read FOwner;
property SubItems : TStrings read FSubItems write FSubItems;//SetSubItems;
property ImageIndex : Integer read FImageIndex write SetImageIndex default -1;
end;
TListItems = class(TPersistent)
@ -470,6 +473,8 @@ type
FSorted : Boolean;
FSortColumn : Integer;
FMultiSelect: Boolean;
FImageList: TImageList;
procedure SetImageList(const AValue: TImageList);
procedure SetMultiSElect(const AValue: Boolean);
procedure SetItems(Value : TListItems);
protected
@ -492,6 +497,7 @@ type
property Sorted : Boolean read FSorted write SetSorted;
property SortColumn : Integer read FSortColumn write SetSortColumn;
property MultiSelect : Boolean read FMultiSelect write SetMultiSelect default False;
property ImageList : TImageList read FImageList write SetImageList;
end;
TListView = class(TCustomListView)
@ -1013,6 +1019,10 @@ end.
{ =============================================================================
$Log$
Revision 1.11 2001/12/21 18:16:59 lazarus
Added TImage class
Shane
Revision 1.10 2001/12/19 21:36:05 lazarus
Added MultiSelect to TListView
Shane

29
lcl/extctrls.pp
View File

@ -41,7 +41,7 @@ interface
{$endif}
uses
SysUtils, Classes, Controls, stdCtrls, vclGlobals, lMessages;
SysUtils, Classes, Controls, stdCtrls, vclGlobals, lMessages,Graphics;
type
{ workaround problem with fcl }
@ -236,7 +236,24 @@ type
// property OnStartDock;
// property OnStartDrag;
end;
TImage = class(TGraphicControl)
private
FPicture: TPicture;
procedure SetPicture(const AValue: TPicture);
Procedure PictureChanged(SEnder : TObject);
protected
public
constructor Create(AOwner: TComponent); override;
published
Property Align;
property Picture : TPicture read FPicture write SetPicture;
property Visible;
property OnCLick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
TBevelStyle=(bsLowered, bsRaised);
TBevelShape=(bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine, bsRightLine);
TBevel=Class(TGraphicControl)
@ -320,7 +337,7 @@ TCN_SELCHANGE = TCN_FIRST - 1;
implementation
uses Graphics, interfaces;
uses interfaces;
{$I page.inc}
{$I customnotebook.inc}
@ -330,11 +347,17 @@ implementation
{$I customradiogroup.inc}
{$I radiogroup.inc}
{$I bevel.inc}
{$I image.inc}
end.
{
$Log$
Revision 1.15 2001/12/21 18:16:59 lazarus
Added TImage class
Shane
Revision 1.14 2001/11/05 18:18:19 lazarus
added popupmenu+arrows to notebooks, added target filename

4
lcl/graphics.pp
View File

@ -732,6 +732,10 @@ end.
{ =============================================================================
$Log$
Revision 1.18 2001/12/21 18:16:59 lazarus
Added TImage class
Shane
Revision 1.17 2001/11/12 22:12:57 lazarus
MG: fixed parser: multiple brackets, nil, string[]

4
lcl/include/bitmap.inc
View File

@ -345,6 +345,10 @@ end;
{ =============================================================================
$Log$
Revision 1.12 2001/12/21 18:16:59 lazarus
Added TImage class
Shane
Revision 1.11 2001/10/10 17:55:04 lazarus
MG: fixed caret lost, gtk cleanup, bracket lvls, bookmark saving

9
lcl/include/customlistview.inc
View File

@ -133,3 +133,12 @@ begin
end;
end;
procedure TCustomListView.SetImageList(const AValue: TImageList);
begin
if AValue <> FImageList then
Begin
FImageList := AValue;
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;
end;

21
lcl/include/image.inc Normal file
View File

@ -0,0 +1,21 @@
{ TImage }
constructor TImage.Create(AOwner: TComponent);
begin
inherited;
fCompStyle := csImage;
FPicture := TPicture.Create;
FPicture.OnChange := @PictureChanged;
Setbounds(0,0,100,100);
end;
procedure TImage.SetPicture(const AValue: TPicture);
begin
FPicture.Assign(AValue); //the onchange of the picture gets called and notifies that something changed.
end;
Procedure TImage.PictureChanged(Sender : TObject);
begin
CNSendMessage(LM_SETPROPERTIES,self,nil);
end;

9
lcl/include/listitem.inc
View File

@ -63,4 +63,13 @@ begin
Inherited Destroy;
end;
procedure TListItem.SetImageIndex(const AValue: Integer);
begin
if AValue <> FImageIndex then
Begin
FImageIndex := AValue;
ItemChanged(self);
end;
end;

3
lcl/include/paintbox.inc
View File

@ -4,8 +4,7 @@ constructor TPaintBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 105;
Height := 105;
setbounds(0,0,105,105);
end;
procedure TPaintBox.Paint;

19
lcl/interfaces/gtk/gtkobject.inc
View File

@ -2277,6 +2277,9 @@ PGtkCList(PGtkFileSelection(P)^.file_list),GTK_SELECTION_MULTIPLE);
gtk_widget_show(p);
end;
csImage : Begin
p := gtk_image_new(nil,nil);
end;
csLabel :
begin
P := gtk_label_new(StrTemp);
@ -3006,6 +3009,7 @@ var
ColName : String;
pColName : PChar;
pRowText : PChar;
Image : PgdkImage;
begin
result := 0; // default if nobody sets it
@ -3172,7 +3176,16 @@ begin
gtk_clist_thaw(PgtkCList(Handle));
end;
end;
csImage: Begin
//Image changed.
Widget := PgtkWidget(PdeviceContext(TBitmap(sender).handle));
Image := gdk_image_get(pgtkWidget(widget)^.window,0,0,widget^.allocation.width,widget^.allocation.height);
if Handle = nil then
TWinControl(sender).Handle := THandle(gtk_image_new(Image,nil))
else
gtk_image_set(PgtkImage(handle),Image,nil);
end;
else
Assert (true, Format ('WARNING:[TgtkObject.SetProperties] failed for %s', [Sender.ClassName]));
end;
@ -3627,6 +3640,10 @@ end;
{ =============================================================================
$Log$
Revision 1.95 2001/12/21 18:17:00 lazarus
Added TImage class
Shane
Revision 1.94 2001/12/20 19:11:23 lazarus
Changed the delay for the hints from 100 miliseconds to 500. I'm hoping this reduces the crashing for some people until I determine the problem.
Shane