MG: image support, TScrollBox, and many other things from Andrew

git-svn-id: trunk@3276 -

ide/findreplacedialog.pp

@@ -176,6 +176,7 @@ begin
     with CaseSensitiveCheckBox do begin
       Name:='CaseSensitiveCheckBox';
       Parent:=OptionsGroupBox;
+      AutoSize := True;
       Left:=8;
       Top:=6;
       Width:=135;
@@ -188,6 +189,7 @@ begin
     with WholeWordsOnlyCheckBox do begin
       Name:='WholeWordsOnlyCheckBox';
       Parent:=OptionsGroupBox;
+      AutoSize := False;
       Left:=8;
       Top:=26;
       Width:=135;
@@ -200,6 +202,7 @@ begin
     with RegularExpressionsCheckBox do begin
       Name:='RegularExpressionsCheckBox';
       Parent:=OptionsGroupBox;
+      AutoSize := False;
       Left:=8;
       Top:=46;
       Width:=135;
@@ -212,6 +215,7 @@ begin
     with PromptOnReplaceCheckBox do begin
       Name:='PromptOnReplaceCheckBox';
       Parent:=OptionsGroupBox;
+      AutoSize := False;
       Left:=8;
       Top:=66;
       Width:=135;

ide/idecomp.pp

@@ -1,7 +1,7 @@
 {
  /***************************************************************************
-                              idecomp.pp  -
+                              idecomp.pp
-                            -------------------
+                              ----------
                              TIDEComponent
 
 
@@ -29,7 +29,7 @@
  *                                                                         *
  ***************************************************************************
 }
-unit idecomp;
+unit IDEComp;
 
 {$mode objfpc}{$H+}
 
@@ -40,8 +40,8 @@ interface
 
 uses
   Classes, LclLinux, StdCtrls, Forms, Buttons, Menus, ComCtrls,Arrow,
-  Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs,Calendar,ImgList
+  Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs, Calendar,
-
+  ImgList
   {$IFDEF DATABASE}
   ,db
   {$ENDIF}
@@ -302,9 +302,6 @@ end;
 
 {--------------------------------------------------}
 
-
-
-
 procedure RegisterStandardComponents(
   ARegisteredComponentList:TRegisteredComponentList);
 
@@ -316,26 +313,26 @@ procedure RegisterStandardComponents(
   end;
 
 begin
-
   RegisterComponentsProc:=@RegisterComponents;
+  
   RegisterComponents('Standard','Menus',[TMainMenu,TPopupMenu]);
   RegisterComponents('Standard','Buttons',[TButton]);
-  RegisterComponents('Standard','StdCtrls',[TEdit,TLabel,TMemo,TCheckBox
+  RegisterComponents('Standard','StdCtrls',[TEdit,TLabel,TMemo,TCheckBox,
-          ,TListBox,TRadioButton,TComboBox,TScrollBar,TGroupBox,TToggleBox]);
+          TListBox,TRadioButton,TComboBox,TScrollBar,TGroupBox,TToggleBox]);
   RegisterComponents('Standard', 'ExtCtrls',[TPanel]);
   RegisterComponents('Additional','Buttons',[TBitBtn,TSpeedButton]);
-  RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox
+  RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox,
-          ,TBevel,TRadioGroup,TImage]);
+          TBevel,TRadioGroup,TImage]);
-  RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView,TTreeView
+  RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView,TTreeView,
-          ,TProgressBar,TToolBar,TTrackbar]);
+          TProgressBar,TToolBar,TTrackbar,TScrollBox]);
   RegisterComponents('Additional','ImgList',[TImageList]);
 
   RegisterComponents('Misc','Calendar',[TCalendar]);
   RegisterComponents('Misc','Arrow',[TArrow]);
 
   RegisterComponents('System','ExtCtrls',[TTimer]);
-  RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog
+  RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog,
-          ,TColorDialog,TFontDialog]);
+          TColorDialog,TFontDialog]);
 
   RegisterComponents('Samples','Spin',[TSpinEdit]);
 
@@ -344,8 +341,10 @@ begin
 {$ENDIF}
 {$IFDEF INTERBASE}
 //Interbase
-  RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,TIBQuery,TIBDatabase]);
+  RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,
+          TIBQuery,TIBDatabase]);
 {$ENDIF}
+
   // unselectable components
   // components that are streamed but not selectable in the IDE
   RegisterComponents('','ExtCtrls',[TPage]);
@@ -353,13 +352,9 @@ begin
   RegisterComponents('','menus', [TMenuItem]);
 
   RegisterComponentsProc:=nil;
-
-
 end;
 
 
-
-
 initialization
 
 {$I images/components_images.lrs}

lcl/comctrls.pp

@@ -467,7 +467,6 @@ type
   TToolButton = class(TButtonControl)
   private
     FAllowAllUp: Boolean;
-    FAutoSize: Boolean;
     FDown: Boolean;
     FGrouped: Boolean;
     FImageIndex: Integer;
@@ -483,7 +482,7 @@ type
     function IsCheckedStored: Boolean;
     function IsImageIndexStored: Boolean;
     function IsWidthStored: Boolean;
-    procedure SetAutoSize(Value: Boolean);
+    procedure SetAutoSize(const Value: Boolean); Override;
     procedure SetButtonState(State: Byte);
     procedure SetDown(Value: Boolean);
     procedure SetDropdownMenu(Value: TPopupMenu);
@@ -518,7 +517,7 @@ type
     property Index: Integer read GetIndex;
   published
     property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;
-    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
+    property AutoSize default False;
     property Caption;
     property Down: Boolean read FDown write SetDown stored IsCheckedStored default False;
     property DragCursor;
@@ -1492,6 +1491,63 @@ type
     property Items;
   end;
 
+  TScrollBox = class(TWinControl)
+  private
+    FAutoScroll : Boolean;
+    Procedure SetAutoScroll(Value : Boolean);
+    Procedure DoAutoSize; Override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Align;
+    property Anchors;
+    property AutoScroll : Boolean read FAutoScroll write SetAutoScroll;
+    property AutoSize;
+    //property BiDiMode;
+    //property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
+    property Constraints;
+    //property DockSite;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Color nodefault;
+    property Ctl3D;
+    property Font;
+    //property ParentBiDiMode;
+    property ParentColor;
+    property ParentCtl3D;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property TabOrder;
+    property TabStop;
+    property Visible;
+    //property OnCanResize;
+    property OnClick;
+    property OnConstrainedResize;
+    property OnDblClick;
+    //property OnDockDrop;
+    //property OnDockOver;
+    property OnDragDrop;
+    property OnDragOver;
+    //property OnEndDock;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    //property OnGetSiteInfo;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnResize;
+    //property OnStartDock;
+    property OnStartDrag;
+    //property OnUnDock;
+  end;
 
 
 function InitCommonControl(CC: Integer): Boolean;
@@ -1551,6 +1607,7 @@ end;
 {$I toolbar.inc}
 {$I trackbar.inc}
 {$I treeview.inc}
+{$I scrollbox.inc}
 
 
 end.
@@ -1558,6 +1615,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.38  2002/09/03 08:07:17  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.37  2002/08/17 15:45:31  lazarus
   MG: removed ClientRectBugfix defines
 

lcl/include/bitbtn.inc

@@ -21,6 +21,7 @@ begin
   Inherited Create(AOwner);
   FCompStyle := csBitBtn;
   FGlyph := TButtonGlyph.Create;
+  TButtonGlyph(FGlyph).OnChange := @GlyphChanged;
   {set default alignment}
   Align := alNone;
   FCanvas := TCanvas.Create;
@@ -68,6 +69,10 @@ Procedure TBitbtn.SetGlyph(Value : TBitmap);
 Begin
   Assert(False, 'Trace:SETGLYPH');
   TButtonGlyph(FGlyph).Glyph := Value;
+end;
+
+procedure TBitBtn.GlyphChanged(Sender: TObject);
+begin
   if HandleAllocated then begin
     CNSendMessage(LM_IMAGECHANGED,Self,nil);
     Invalidate;

lcl/include/bitmap.inc

@@ -23,7 +23,8 @@ end;
 
 procedure TBitmap.Draw(ACanvas: TCanvas; const Rect: TRect);
 begin
-  Assert(False, 'Trace:TODO: [TBitmap.Draw]');
+  HandleNeeded;
+  ACanvas.CopyRect(Rect, Self.Canvas, Classes.Rect(0, 0, Width, Height));
 end;
 
 constructor TBitmap.Create;
@@ -50,6 +51,7 @@ end;
 
 procedure TBitMap.FreeImage;
 begin
+  Handle := 0;
 end;
 
 function TBitmap.HandleAllocated: boolean;
@@ -74,7 +76,10 @@ begin
 end;
 
 procedure TBitMap.HandleNeeded;
-var n : integer;
+var
+  n : integer;
+  UseWidth,
+  UseHeight : Longint;
 begin
 //  if FHandle = 0 then CNSendMessage(LM_CREATE, Self, nil);
   if FImage.FHandle = 0 then begin
@@ -89,9 +94,11 @@ begin
       pf32bit : n:= 32;
       else raise EInvalidOperation.Create('Unsupported bitmap format.');
     end;
-    if Width<1 then Width:=1;
+    UseWidth := Width;
-    if Height<1 then Height:=1;
+    UseHeight := Height;
-    FImage.FHandle:= CreateBitmap(Width, Height, 1, n, nil);
+    if UseWidth<1 then UseWidth:=1;
+    if UseHeight<1 then UseHeight:=1;
+    FImage.FHandle:= CreateBitmap(UseWidth, UseHeight, 1, n, nil);
   end;
 end;
 
@@ -145,6 +152,10 @@ Begin
   end;
 end;
 
+Procedure TBitmap.LoadFromFile(Const Filename : String);
+begin
+  LoadFromXPMFile(FileName);
+end;
 
 Procedure TBitmap.NewImage(NHandle: HBITMAP; NPallette: HPALETTE;
    const NDIB : TDIBSection; OS2Format : Boolean);
@@ -158,31 +169,6 @@ end;
 
 procedure TBitmap.ReadStream(Stream: TStream; Size: Longint);
 type
-  BITMAP = packed record
-          bmType : Longint;
-          bmWidth : Longint;
-          bmHeight : Longint;
-          bmWidthBytes : Longint;
-          bmPlanes : Word;
-          bmBitsPixel : Word;
-          bmBits : Pointer;
-       end;
-  PBITMAP = ^BITMAP;
-
-  BITMAPINFOHEADER = packed record
-          biSize : DWORD;
-          biWidth : Longint;
-          biHeight : Longint;
-          biPlanes : WORD;
-          biBitCount : WORD;
-          biCompression : DWORD;
-          biSizeImage : DWORD;
-          biXPelsPerMeter : Longint;
-          biYPelsPerMeter : Longint;
-          biClrUsed : DWORD;
-          biClrImportant : DWORD;
-       end;
-
   RGBQUAD = packed record
           rgbBlue : BYTE;
           rgbGreen : BYTE;
@@ -211,7 +197,6 @@ var
   ImgSize:longint;
   Bits:PBitsObj;
   InfoSize: integer;
-  //BmpWidth,BmpHeight:integer;
   BitsPerPixel,ColorsUsed:integer;
 begin
   FreeContext;
@@ -251,9 +236,6 @@ begin
       // Palette is fake now. Then it'll be better!
       // EInOutError.Create('Only truecolor is supported yet.');
 
-      //BmpHeight:=BmpInfo^.bmiHeader.biHeight;
-      //BmpWidth:=BmpInfo^.bmiHeader.biWidth;
-      
       ImgSize:=BmpInfo^.bmiHeader.biSizeImage;
       GetMem(Bits,ImgSize);
       try
@@ -261,7 +243,8 @@ begin
         if ReadSize<>ImgSize then
           raise EInOutError.Create('Invalid windows bitmap (bits)');
 
-        // ToDo: create a bitmap handle
+        Handle := CreateBitmap(Width, Height,
+          BmpInfo^.bmiHeader.biPlanes, BitsPerPixel, Bits);
 
       finally
         FreeMem(Bits);
@@ -290,8 +273,7 @@ end;
 
 procedure TBitmap.SetHandle(Value: HBITMAP);
 begin
-  // TODO: get the properties from new bitmap (Width, Height)
+  // TODO: the properties from new bitmap
-  //       When this is done, then check TPixmap.ReadStream
   with FImage do
     if FHandle <> Value then
     begin
@@ -300,6 +282,9 @@ begin
       FImage := TBitmapImage.Create;
       Reference;
       FHandle:=Value;
+      FillChar(FDIB, sizeof(FDIB), 0);
+      if Value <> 0 then
+        GetObject(FHandle, SizeOf(FDIB), @FDIB);
       Changed(Self);
     end;
 end;
@@ -319,6 +304,7 @@ end;
 
 Function TBitmap.ReleaseHandle : HBITMAP;
 Begin
+  If HandleAllocated then
     Result := GetHandle;
   FImage.FHandle := 0;
 end;
@@ -331,12 +317,14 @@ end;
 
 function TBitmap.GetHeight: Integer;
 begin
-  Result := FHeight;
+  with FImage do
+    Result := FDIB.dsbm.bmHeight;
 end;
 
 function TBitmap.GetWidth: Integer;
 begin
-  Result := FWidth;
+  with FImage do
+    Result := FDIB.dsbm.bmWidth;
 end;
 
 procedure TBitmap.ReadData(Stream: TStream);
@@ -354,20 +342,38 @@ end;
 
 procedure TBitmap.SetWidth(Value: Integer);
 begin
-  FWidth:=Value;
+  with FImage do
-  // ToDo
+    if FDIB.dsbm.bmWidth <> Value then
+    begin
+      FDIB.dsbm.bmWidth := Value;
+      If (Value > 0) and (Height > 0) then
+        HandleNeeded
+      else
+        FreeImage;
+      Changed(Self);
+    end;
 end;
 
 procedure TBitmap.SetHeight(Value: Integer);
 begin
-  FHeight:=Value;
+  with FImage do
-  // ToDo
+    if FDIB.dsbm.bmHeight <> Value then
+    begin
+      FDIB.dsbm.bmHeight := Value;
+      If (Value > 0) and (Width > 0) then
+        HandleNeeded
+      else
+        FreeImage;
+      Changed(Self);
+    end;
 end;
-
 
 { =============================================================================
 
   $Log$
+  Revision 1.16  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.15  2002/09/02 08:13:16  lazarus
   MG: fixed GraphicClass.Create
 

lcl/include/buttonglyph.inc

@@ -20,6 +20,7 @@ constructor TButtonGlyph.Create;
 begin
 //  Inherited Create;
   FOriginal := TBitmap.Create;
+  FOriginal.OnChange := @GlyphChanged;
 end;
 
 {------------------------------------------------------------------------------}
@@ -35,20 +36,28 @@ end;
 {       TButtonGlyph SetGlyph                                                  }
 {------------------------------------------------------------------------------}
 procedure TButtonGlyph.SetGlyph(Value : TBitmap);
-var GlyphCount : integer;
+var
+  GlyphCount : integer;
 begin
   if FOriginal = Value then exit;
 //  FOriginal.Assign(Value);
   FOriginal.Free;
   FOriginal:= Value;
-  if (Value <> nil) and (Value.Height > 0) then begin
+  FOriginal.OnChange := @GlyphChanged;
-    if Value.Width mod Value.Height = 0 then begin
+  if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
-      GlyphCount:= Value.Width div Value.Height;
+    if FOriginal.Width mod FOriginal.Height = 0 then begin
+      GlyphCount:= FOriginal.Width div FOriginal.Height;
       if GlyphCount > 4 then GlyphCount:= 1;
-      NumGlyphs:= GlyphCount;
+      FNumGlyphs:= GlyphCount;
     end;
   end;
-  //Invalidate;
+  GlyphChanged(FOriginal);
+end;
+
+procedure TButtonGlyph.GlyphChanged(Sender: TObject);
+begin
+  if Sender = FOriginal then
+    if Assigned(FOnChange) then FOnChange(Self);
 end;
 
 {------------------------------------------------------------------------------}
@@ -100,6 +109,6 @@ procedure TButtonGlyph.SetNumGlyphs(Value : TNumGlyphs);
 begin
   if Value <> FNumGlyphs then begin
     FNumGlyphs := Value;
-    if Assigned(FOnChange) then FOnChange(Glyph);
+    GlyphChanged(FOriginal);
   end;
 end;

lcl/include/checkbox.inc

@@ -35,25 +35,25 @@ end;
 procedure TCheckbox.SetText(const Value: TCaption);
 begin
   Inherited SetText(Value);
-  AutoSize := FAutoSize;
+  DoAutoSize;
 end;
 
 {------------------------------------------------------------------------------
-  Method: TCheckbox.SetAutoSize
+  Method: TCheckbox.DoAutoSize
   Params:  Value : Boolean
   Returns: nothing
 
-  Sets AutoSize Flag, and if True, attempts to Size to fit Caption
+  Attempts to Size to fit Caption if AutoSize is True
  ------------------------------------------------------------------------------}
-procedure TCheckbox.SetAutoSize(Value : Boolean);
+procedure TCheckbox.DoAutoSize;
 var
   R : TRect;
   DC : hDC;
 begin
-  FAutoSize := Value;
+  If AutoSizing or not AutoSize then
-  If not AutoSize then
     Exit;
   if not HandleAllocated then exit;
+  AutoSizing := True;
   DC := GetDC(Handle);
   Try
     R := Rect(0,0, Width, Height);
@@ -65,6 +65,7 @@ begin
       Height := R.Bottom + 2;
   Finally
     ReleaseDC(Handle, DC);
+    AutoSizing := False;
   end;
 end;
 
@@ -72,6 +73,9 @@ end;
 
 {
   $Log$
+  Revision 1.6  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.5  2002/08/24 06:51:22  lazarus
   MG: from Andrew: style list fixes, autosize for radio/checkbtns
 

lcl/include/customform.inc

@@ -180,7 +180,7 @@ end;
 function TCustomForm.GetIconHandle: HICON;
 begin
 //writeln('[TCustomForm.GetIconHandle] ',ClassName,' ',FIcon<>nil);
-  if FIcon<>nil then
+  if (FIcon<>nil) and not Icon.Empty then
     Result := FIcon.Handle
   else
     Result := Application.GetIconHandle;
@@ -1025,6 +1025,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.54  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.53  2002/08/31 11:37:09  lazarus
   MG: fixed destroying combobox
 

lcl/include/customradiogroup.inc

@@ -112,6 +112,7 @@ begin
     while (FButtonList.Count<FItems.Count) do begin
       Temp := TRadioButton.Create (self);
       Temp.Name:='RadioButton'+IntToStr(FButtonList.Count);
+      Temp.AutoSize := False;
       Temp.Parent := Self;
       Temp.OnClick := @Clicked;
       FButtonList.Add(Temp);
@@ -337,6 +338,9 @@ end;
 
 {
   $Log$
+  Revision 1.14  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.13  2002/08/30 12:32:20  lazarus
   MG: MoveWindowOrgEx, Splitted FWinControls/FControls, TControl drawing, Better DesignerDrawing, ...
 

lcl/include/form.inc

@@ -28,6 +28,7 @@ end;
 constructor TForm.Create(AOwner : TComponent);
 begin
   inherited Create(AOwner);
+  Icon := TIcon.Create;
 end;
 
 

lcl/include/image.inc

@@ -16,20 +16,119 @@
 
 constructor TImage.Create(AOwner: TComponent);
 begin
-   inherited;
+   inherited Create(AOwner);
-   fCompStyle := csImage;
+   FCompStyle := csImage;
+   ControlStyle:= [csCaptureMouse, csDoubleClicks];
+   FAutoSize := False;
+   FCenter := False;
+   FStretch := False;
+   FTransparent := True;
    FPicture := TPicture.Create;
    FPicture.OnChange := @PictureChanged;
    Setbounds(0,0,100,100);
 end;
 
+destructor TImage.Destroy;
+begin
+  FPicture.OnChange := nil;
+  FPicture.Graphic := nil;
+  FPicture.Free;
+  inherited;
+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);
+procedure TImage.SetAutoSize(Value : Boolean);
+var
+  ModifyWidth,
+  ModifyHeight : Boolean;
 begin
-  CNSendMessage(LM_SETPROPERTIES,self,nil);
+  If Value then begin
+    ModifyWidth := (Align = alleft) or (Align = alRight) or (Align = alNone);
+    ModifyHeight := (Align = alTop) or (Align = alBottom) or (Align = alNone);
+    If ModifyWidth and (Picture.Width > 0) then
+      Width := Max(Picture.Width, CONSTRAINTS.MinWidth);
+    If ModifyHeight and (Picture.Height > 0) then
+      Height := Max(Picture.Height, CONSTRAINTS.MinHeight);
+    PictureChanged(Self);
+  end;
+  FAutoSize := Value;
 end;
 
+procedure TImage.SetStretch(Value : Boolean);
+begin
+  FStretch := Value;
+  PictureChanged(Self);
+end;
+
+procedure TImage.SetTransparent(Value : Boolean);
+begin
+  FTransparent := Value;
+  PictureChanged(Self);
+end;
+
+procedure TImage.SetCenter(Value : Boolean);
+begin
+  FCenter := Value;
+  PictureChanged(Self);
+end;
+
+Procedure TImage.PictureChanged(Sender : TObject);
+begin
+  If AutoSize then begin
+    SetAutoSize(False);
+    SetAutoSize(True);
+  end;
+  Invalidate;
+end;
+
+Procedure TImage.Paint;
+
+  Procedure DrawFrame;
+  begin
+    if csDesigning in ComponentState then begin
+      With Canvas do begin
+        Pen.Color := clBlack;
+        Pen.Style := psDash;
+        MoveTo(0, 0);
+        LineTo(Width, 0);
+        LineTo(Width, Height);
+        LineTo(0, Height);
+        LineTo(0, 0);
+      end;
+    end;
+  end;
+
+var
+  RGN : longint;
+  iRect : TRect;
+begin
+  With Canvas do begin
+    RGN := CreateRectRGN(0, 0, Width + 1, Height + 1);
+    SelectClipRGN(Handle, RGN);
+    DeleteObject(RGN);
+    DrawFrame;
+    If Picture.Graphic = nil then
+      exit;
+    If Stretch then
+      iRect := Rect(0, 0, Width + 1, Height + 1)
+    else
+      iRect := Rect(0,0, Picture.Width, Picture.Height);
+    If Center then
+      OffsetRect(iRect,
+        (Width + 1) div 2 - (iRect.Right - iRect.Left) div 2,
+        (Height + 1) div 2 - (iRect.Bottom -iRect.Top) div 2);
+    If Picture.Graphic.Transparent and not Transparent then
+    begin
+      If Picture.Graphic is TBitmap then
+        Brush.Color := TBitmap(Picture.Graphic).TransparentColor
+      else
+        Brush.Color := clWhite;
+      FillRect(iRect);
+    end;
+    StretchDraw(iRect, Picture.Graphic);
+  end;
+end;

lcl/include/picture.inc

@@ -45,6 +45,14 @@ begin
   Add('bmp', 'Bitmaps', TBitmap);
   Add('xpm', 'Pixmap', TPixmap);
   Add('ico', 'Icon', TIcon);
+{      ('.xpm',
+     '.bmp',
+     '.png',
+     '.gif',
+     '.jpg',
+     '.jpeg',
+     '.tiff');}
+
 end;
 
 procedure TPicFileFormatsList.Clear;
@@ -338,25 +346,27 @@ end;
 procedure TPicture.SetGraphic(Value: TGraphic);
 var
   NewGraphic: TGraphic;
-  ok: boolean;
+  //ok: boolean;
 begin
   NewGraphic := nil;
   if Value <> nil then begin
-    NewGraphic := TGraphicClass(Value.ClassType).Create;
+    //NewGraphic := TGraphicClass(Value.ClassType).Create;
-    NewGraphic.Assign(Value);
+    //NewGraphic.Assign(Value);
+    NewGraphic := Value;//Assign Doesn't Work yet
     NewGraphic.OnChange := @Changed;
     NewGraphic.OnProgress := @Progress;
   end;
-  ok:=false;
+  //ok:=false;
   try
     FGraphic.Free;
     FGraphic := NewGraphic;
     Changed(Self);
-    ok:=true;
+    //ok:=true;
   finally
     // this try..finally construction will in case of an exception
     // not alter the error backtrace output
-    if not ok then NewGraphic.Free;
+
+    //if not ok then NewGraphic.Free;
   end;
 end;
 
@@ -376,28 +386,23 @@ begin
   if GraphicClass = nil then
     raise EInvalidGraphic.CreateFmt('Unknown picture extension', [Ext]);
 
-writeln('TPicture.LoadFromFile A ',GraphicClass.ClassName);
     NewGraphic := GraphicClass.Create;
-writeln('TPicture.LoadFromFile B ',NewGraphic.ClassName);
+
   ok:=false;
   try
     NewGraphic.OnProgress := @Progress;
-writeln('TPicture.LoadFromFile C ');
     NewGraphic.LoadFromFile(Filename);
-writeln('TPicture.LoadFromFile D ');
     ok:=true;
   finally
     // this try..finally construction will in case of an exception
     // not alter the error backtrace output
     if not ok then NewGraphic.Free;
   end;
-writeln('TPicture.LoadFromFile E ');
+  If FGraphic <> nil then
     FGraphic.Free;
-writeln('TPicture.LoadFromFile F ');
   FGraphic := NewGraphic;
   FGraphic.OnChange := @Changed;
   Changed(Self);
-writeln('TPicture.LoadFromFile END ');
 end;
 
 procedure TPicture.SaveToFile(const Filename: string);

lcl/include/radiobutton.inc

@@ -158,25 +158,25 @@ procedure TRadioButton.SetText(const Value: TCaption);
 begin
   Inherited SetText(Value);
   RecreateWnd;
-  AutoSize := FAutoSize;
+  DoAutoSize;
 end;
 
 {------------------------------------------------------------------------------
-  Method: TCheckbox.SetAutoSize
+  Method: TCheckbox.DoAutoSize
   Params:  Value : Boolean
   Returns: nothing
 
-  Sets AutoSize Flag, and if True, attempts to Size to fit Caption
+  Attempts to Size to fit Caption if AutoSize is True
  ------------------------------------------------------------------------------}
-procedure TRadioButton.SetAutoSize(Value : Boolean);
+procedure TRadioButton.DoAutoSize;
 var
   R : TRect;
   DC : hDC;
 begin
-  FAutoSize := Value;
+  If Autosizing or not AutoSize then
-  If not AutoSize then
     Exit;
   if not HandleAllocated then exit;
+  AutoSizing := True;
   DC := GetDC(Handle);
   Try
     R := Rect(0,0, Width, Height);
@@ -188,6 +188,7 @@ begin
       Height := R.Bottom + 2;
   Finally
     ReleaseDC(Handle, DC);
+    AutoSizing := False;
   end;
 end;
 // included by stdctrls.pp
@@ -195,6 +196,9 @@ end;
 
 {
   $Log$
+  Revision 1.7  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.6  2002/08/24 06:51:22  lazarus
   MG: from Andrew: style list fixes, autosize for radio/checkbtns
 

lcl/include/toolbutton.inc

@@ -176,11 +176,11 @@ begin
   if FMarked then Result := Result or ButtonStates[tbsMarked];
 end;
 
-procedure TToolButton.SetAutoSize(Value: Boolean);
+procedure TToolButton.SetAutoSize(const Value: Boolean);
 begin
   if Value <> AutoSize then
   begin
-    FAutoSize := Value;
+    Inherited SetAutoSize(Value);
     UpdateControl;
     if not (csLoading in ComponentState) and (FToolBar <> nil) and
       FToolBar.ShowCaptions then
@@ -454,6 +454,9 @@ end;
 
 {
   $Log$
+  Revision 1.3  2002/09/03 08:07:20  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.2  2002/05/10 06:05:56  lazarus
   MG: changed license to LGPL
 

lcl/lcltype.pp

@@ -148,6 +148,7 @@ const
   DT_NOCLIP = $100;
   DT_CALCRECT = $400;
   DT_NOPREFIX = $800;
+  DT_INTERNAL = $1000;
 
 //==============================================
 // Draw frame constants
@@ -725,6 +726,22 @@ type
   end;
   BITMAP = tagBITMAP;
 
+  PBitmapInfoHeader = ^TagBitmapInfoHeader;
+  tagBITMAPINFOHEADER = packed record
+    biSize : DWORD;
+    biWidth : Longint;
+    biHeight : Longint;
+    biPlanes : WORD;
+    biBitCount : WORD;
+    biCompression : DWORD;
+    biSizeImage : DWORD;
+    biXPelsPerMeter : Longint;
+    biYPelsPerMeter : Longint;
+    biClrUsed : DWORD;
+    biClrImportant : DWORD;
+  end;
+  BITMAPINFOHEADER = tagBITMAPINFOHEADER;
+
 { ********************************** }
 {        B I T M A P    S T U F F    }
 
@@ -744,7 +761,7 @@ type
 
   tagDIBSECTION = packed record
     dsBm: TagBitmap;
-    dsBmih: pointer;//TBitmapInfoHeader;
+    dsBmih: tagBITMAPINFOHEADER;
     dsBitfields: array[0..2] of DWORD;
     dshSection: THandle;
     dsOffset: DWORD;
@@ -752,7 +769,6 @@ type
   TDIBSection = tagDIBSECTION;
   DIBSECTION = tagDIBSECTION;
 
-
 const
   TRUETYPE_FONTTYPE = 4;
 
@@ -1470,6 +1486,9 @@ end.
 
 {
   $Log$
+  Revision 1.13  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.12  2002/08/27 06:40:50  lazarus
   MG: ShortCut support for buttons from Andrew
 

lcl/stdctrls.pp

@@ -495,15 +495,13 @@ type
   end;
 
   TCheckBox = class(TCustomCheckBox)
-  private
-    FAutoSize : Boolean;
-    procedure SetAutoSize(Value : Boolean);
   protected
+    procedure DoAutoSize; Override;
     procedure SetText(const Value: TCaption); Override;
   public
     constructor Create(AOwner: TComponent); override;
   published
-    property AutoSize : Boolean read FAutoSize write SetAutoSize;
+    property AutoSize;
     property AllowGrayed;
     property Anchors;
     property Caption;
@@ -570,11 +568,10 @@ type
   TRadioButton = class(TCustomCheckBox)
   private
     fGroup : THandle; // handle to the previous button in the group this button belongs to
-    FAutoSize : Boolean;
     procedure SetGroup (Value : THandle);
     function GetGroup : THandle;
-    procedure SetAutoSize(Value : Boolean);
   protected
+    procedure DoAutoSize; Override;
     procedure CreateWnd; override;
     procedure DestroyWnd; override;
     procedure SetText(const Value: TCaption); Override;
@@ -583,7 +580,7 @@ type
     property group : THandle read GetGroup write SetGroup;
   published
     property Anchors;
-    property AutoSize : Boolean read FAutoSize write SetAutoSize;
+    property AutoSize;
     property AllowGrayed;
     property Caption;
     property Checked;
@@ -714,7 +711,11 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.39  2002/09/03 08:07:19  lazarus
+  MG: image support, TScrollBox, and many other things from Andrew
+
   Revision 1.38  2002/08/30 06:46:03  lazarus
+
   Use comboboxes. Use history. Prettify the dialog. Preselect text on show.
   Make the findreplace a dialog. Thus removing resiying code (handled by Anchors now anyway).
   Make Anchors work again and publish them for various controls.