Added TImage class

Shane

git-svn-id: trunk@554 -

.gitattributes

@@ -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

ide/idecomp.pp

@@ -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]);
 

images/components/timage.xpm

@@ -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"};

images/components_images.lrs

@@ -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'

lcl/comctrls.pp

@@ -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

lcl/extctrls.pp

@@ -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 }
@@ -237,6 +237,23 @@ type
 //    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
 

lcl/graphics.pp

@@ -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[]
 

lcl/include/bitmap.inc

@@ -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
 

lcl/include/customlistview.inc

@@ -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;

lcl/include/image.inc

@@ -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;
+

lcl/include/listitem.inc

@@ -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;
+
 

lcl/include/paintbox.inc

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

lcl/interfaces/gtk/gtkobject.inc

@@ -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