tvplanit: Background image in NavBar

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4991 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/tvplanit/examples/navbar/unit1.lfm

@@ -1,22 +1,22 @@
 object Form1: TForm1
   Left = 262
-  Height = 367
+  Height = 400
   Top = 155
   Width = 588
   Caption = 'Form1'
-  ClientHeight = 367
+  ClientHeight = 400
   ClientWidth = 588
   OnCreate = FormCreate
   LCLVersion = '1.7'
   object VpNavBar1: TVpNavBar
     Left = 0
-    Height = 337
+    Height = 370
     Top = 0
     Width = 128
     ActiveFolder = 0
     AllowRearrange = True
     BackgroundColor = clInactiveCaption
-    BackgroundMethod = bmNormal
+    BackgroundMethod = bmTile
     BorderStyle = bsNone
     ButtonHeight = 20
     DrawingStyle = dsEtchedButton
@@ -128,7 +128,7 @@ object Form1: TForm1
     Align = alLeft
     ParentColor = False
   end
-  object RadioGroup1: TRadioGroup
+  object RgDrawingStyle: TRadioGroup
     Left = 141
     Height = 116
     Top = 32
@@ -151,7 +151,7 @@ object Form1: TForm1
       'dsCoolTab'
       'dsStandardTab'
     )
-    OnClick = RadioGroup1Click
+    OnClick = RgDrawingStyleClick
     TabOrder = 1
   end
   object Label1: TLabel
@@ -165,7 +165,7 @@ object Form1: TForm1
   object Panel1: TPanel
     Left = 0
     Height = 30
-    Top = 337
+    Top = 370
     Width = 588
     Align = alBottom
     ClientHeight = 30
@@ -203,28 +203,28 @@ object Form1: TForm1
     end
   end
   object BtnAddFolder: TButton
-    Left = 141
+    Left = 296
     Height = 25
-    Top = 160
+    Top = 112
     Width = 83
     Caption = 'Add folder...'
     OnClick = BtnAddFolderClick
     TabOrder = 3
   end
   object BtnAddItem: TButton
-    Left = 141
+    Left = 392
     Height = 25
-    Top = 193
+    Top = 112
     Width = 83
     Caption = 'Add item...'
     OnClick = BtnAddItemClick
     TabOrder = 4
   end
-  object RadioGroup2: TRadioGroup
-    Left = 301
-    Height = 65
+  object RgIconSize: TRadioGroup
+    Left = 296
+    Height = 49
     Top = 32
-    Width = 91
+    Width = 139
     AutoFill = True
     Caption = 'Icons'
     ChildSizing.LeftRightSpacing = 6
@@ -233,22 +233,126 @@ object Form1: TForm1
     ChildSizing.ShrinkHorizontal = crsScaleChilds
     ChildSizing.ShrinkVertical = crsScaleChilds
     ChildSizing.Layout = cclLeftToRightThenTopToBottom
-    ChildSizing.ControlsPerLine = 1
-    ClientHeight = 45
-    ClientWidth = 87
+    ChildSizing.ControlsPerLine = 2
+    ClientHeight = 29
+    ClientWidth = 135
+    Columns = 2
     ItemIndex = 0
     Items.Strings = (
       'large'
       'small'
     )
-    OnClick = RadioGroup2Click
+    OnClick = RgIconSizeClick
     TabOrder = 5
   end
+  object GroupBox1: TGroupBox
+    Left = 141
+    Height = 112
+    Top = 168
+    Width = 411
+    Caption = 'Background'
+    ClientHeight = 92
+    ClientWidth = 407
+    TabOrder = 6
+    object BkColor: TColorBox
+      Left = 88
+      Height = 24
+      Top = 3
+      Width = 272
+      Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbCustomColors]
+      ItemHeight = 16
+      OnChange = BackgroundColorChange
+      TabOrder = 0
+    end
+    object RbBkColor: TRadioButton
+      Left = 14
+      Height = 19
+      Top = 3
+      Width = 49
+      Caption = 'Color'
+      Checked = True
+      OnChange = RbBkColorChange
+      TabOrder = 3
+      TabStop = True
+    end
+    object RbBkImage: TRadioButton
+      Left = 16
+      Height = 19
+      Top = 34
+      Width = 53
+      Caption = 'Image'
+      OnChange = RbBkColorChange
+      TabOrder = 1
+    end
+    object EdBkImage: TFileNameEdit
+      Left = 88
+      Height = 23
+      Top = 33
+      Width = 299
+      FileName = 'bkimg.jpg'
+      Filter = 'BMP files (*.bmp)|*.bmp|PNG files (*.png)|*.png|JPEG files (*.jpg; *.jpeg)|*.jpg;*.jpeg'
+      FilterIndex = 0
+      HideDirectories = False
+      ButtonWidth = 23
+      NumGlyphs = 1
+      MaxLength = 0
+      TabOrder = 2
+      Text = 'bkimg.jpg'
+    end
+    object Panel2: TPanel
+      Left = 80
+      Height = 26
+      Top = 62
+      Width = 229
+      BevelOuter = bvNone
+      ClientHeight = 26
+      ClientWidth = 229
+      TabOrder = 4
+      object RbBkImageNormal: TRadioButton
+        Left = 8
+        Height = 19
+        Top = 4
+        Width = 58
+        Caption = 'normal'
+        OnChange = RbBkColorChange
+        TabOrder = 1
+      end
+      object RbBkImageStretch: TRadioButton
+        Left = 88
+        Height = 19
+        Top = 4
+        Width = 56
+        Caption = 'stretch'
+        OnChange = RbBkColorChange
+        TabOrder = 0
+      end
+      object RbBkImageTile: TRadioButton
+        Left = 168
+        Height = 19
+        Top = 4
+        Width = 36
+        Caption = 'tile'
+        Checked = True
+        OnChange = RbBkColorChange
+        TabOrder = 2
+        TabStop = True
+      end
+    end
+    object BtnLoadBkImage: TButton
+      Left = 304
+      Height = 25
+      Top = 62
+      Width = 56
+      Caption = 'Load'
+      OnClick = BtnLoadBkImageClick
+      TabOrder = 5
+    end
+  end
   object Images: TImageList
     Height = 32
     Width = 32
-    left = 424
-    top = 40
+    left = 488
+    top = 32
     Bitmap = {
       4C690A0000002000000020000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
       FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF

components/tvplanit/examples/navbar/unit1.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  StdCtrls, VpNavBar;
+  StdCtrls, ColorBox, EditBtn, VpNavBar;
 
 type
 
@@ -16,22 +16,35 @@ type
     Bevel1: TBevel;
     BtnAddFolder: TButton;
     BtnAddItem: TButton;
+    BkColor: TColorBox;
+    BtnLoadBkImage: TButton;
+    EdBkImage: TFileNameEdit;
+    GroupBox1: TGroupBox;
     IconsLbl: TLabel;
     IconsLink: TLabel;
-    RadioGroup2: TRadioGroup;
+    Panel2: TPanel;
+    RbBkColor: TRadioButton;
+    RbBkImage: TRadioButton;
+    RbBkImageTile: TRadioButton;
+    RbBkImageStretch: TRadioButton;
+    RbBkImageNormal: TRadioButton;
+    RgIconSize: TRadioGroup;
     Label1: TLabel;
     Images: TImageList;
     Panel1: TPanel;
-    RadioGroup1: TRadioGroup;
+    RgDrawingStyle: TRadioGroup;
     VpNavBar1: TVpNavBar;
+    procedure BackgroundColorChange(Sender: TObject);
     procedure BtnAddFolderClick(Sender: TObject);
     procedure BtnAddItemClick(Sender: TObject);
+    procedure BtnLoadBkImageClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure IconsLinkClick(Sender: TObject);
     procedure IconsLinkMouseEnter(Sender: TObject);
     procedure IconsLinkMouseLeave(Sender: TObject);
-    procedure RadioGroup1Click(Sender: TObject);
-    procedure RadioGroup2Click(Sender: TObject);
+    procedure RgDrawingStyleClick(Sender: TObject);
+    procedure RgIconSizeClick(Sender: TObject);
+    procedure RbBkColorChange(Sender: TObject);
     procedure VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
     procedure VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; Index: Integer);
@@ -53,6 +66,11 @@ uses
 
 { TForm1 }
 
+procedure TForm1.BackgroundColorChange(Sender: TObject);
+begin
+  VpNavBar1.BackgroundColor := BkColor.Selected;
+end;
+
 procedure TForm1.BtnAddFolderClick(Sender: TObject);
 var
   s: String;
@@ -81,11 +99,82 @@ begin
   end;
 end;
 
+procedure TForm1.BtnLoadBkImageClick(Sender: TObject);
+var
+  ext: String;
+  bmp: TBitmap;
+  jpg: TJpegImage;
+  png: TPortableNetworkGraphic;
+begin
+  if EdBkImage.FileName = '' then
+    exit;
+  if not FileExists(EdBkImage.FileName) then
+    exit;
+  ext := Lowercase(ExtractFileExt(EdBkImage.FileName));
+  case ext of
+    '.bmp':
+      VpNavBar1.BackgroundImage.LoadFromFile(EdBkImage.FileName);
+    '.png':
+      begin
+        png := TPortableNetworkGraphic.Create;
+        try
+          png.LoadFromFile(EdBkImage.FileName);
+          VpNavBar1.BackgroundImage.Assign(png);
+        finally
+          png.Free;
+        end;
+      end;
+    '.jpg', '.jpeg':
+      begin
+        jpg := TJpegImage.Create;
+        try
+          jpg.LoadFromFile(EdBkImage.FileName);
+          VpNavBar1.BackgroundImage.Assign(jpg);
+        finally
+          jpg.Free;
+        end;
+      end;
+  end;
+  {
+  pic := TPicture.Create;
+  try
+    pic.LoadFromFile(EdBkImage.FileName);
+    bmp := TBitmap.Create;
+    bmp.Assign(pic);
+    VpNavBar1.BackgroundImage.Assign(bmp);
+  finally
+    pic.Free;
+  end;
+  }
+end;
+
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   RandSeed := 1;
   IconsLink.Left := IconsLbl.Left + IconsLbl.Width;
-  RadioGroup1.ItemIndex := ord(VpNavBar1.DrawingStyle);
+  RgDrawingStyle.ItemIndex := ord(VpNavBar1.DrawingStyle);
+  BkColor.Selected := VpNavBar1.BackgroundColor;
+  case VpNavBar1.BackgroundMethod of
+    bmNone:
+      RbBkColor.Checked := true;
+    bmNormal:
+      begin
+        RbBkImage.Checked := true;
+        RbBkImageNormal.Checked := true;
+      end;
+    bmStretch:
+      begin
+        RbBkImage.Checked := true;
+        RbBkImageStretch.Checked := true;
+      end;
+    bmTile:
+      begin
+        RbBkImage.Checked := true;
+        RbBkImageTile.Checked := true;
+      end;
+  end;
+  BtnLoadBkImageClick(nil);
+
 end;
 
 procedure TForm1.IconsLinkClick(Sender: TObject);
@@ -103,27 +192,47 @@ begin
   IconsLink.Font.style := IconsLink.Font.Style - [fsUnderline];
 end;
 
-procedure TForm1.RadioGroup1Click(Sender: TObject);
+procedure TForm1.RgDrawingStyleClick(Sender: TObject);
 begin
-  VpNavBar1.DrawingStyle := TVpFolderDrawingStyle(Radiogroup1.ItemIndex);
+  VpNavBar1.DrawingStyle := TVpFolderDrawingStyle(RgDrawingStyle.ItemIndex);
 end;
 
-procedure TForm1.RadioGroup2Click(Sender: TObject);
+procedure TForm1.RgIconSizeClick(Sender: TObject);
 var
   folder: TVpNavFolder;
 begin
+  RgIconSize.OnClick := nil;
   folder := VpNavBar1.Folders[VpNavBar1.ActiveFolder];
-  folder.IconSize := TVpIconSize(RadioGroup1.ItemIndex);
+  folder.IconSize := TVpIconSize(RgDrawingStyle.ItemIndex);
+  RgIconSize.OnClick := @RgIconSizeClick;
+end;
+
+procedure TForm1.RbBkColorChange(Sender: TObject);
+begin
+  if RbBkColor.Checked then
+    VpNavBar1.BackgroundMethod := bmNone
+  else
+  if RbBkImage.Checked then begin
+    if RbBkImageNormal.Checked then
+      VpNavBar1.BackgroundMethod := bmNormal
+    else
+    if RbBkImageStretch.Checked then
+      VpNavBar1.BackgroundMethod := bmStretch
+    else
+    if RbBkImageTile.Checked then
+      VpNavBar1.BackgroundMethod := bmTile;
+  end;;
+  VpNavBar1.Invalidate;
 end;
 
 procedure TForm1.VpNavBar1FolderChanged(Sender: TObject; Index: Integer);
 var
   folder: TVpNavFolder;
 begin
-  RadioGroup2.OnClick := nil;
+  RgIconSize.OnClick := nil;
   folder := VpNavBar1.Folders[Index];
-  RadioGroup2.ItemIndex := ord(folder.IconSize);
-  RadioGroup2.OnClick := @RadioGroup2Click;
+  RgIconSize.ItemIndex := ord(folder.IconSize);
+  RgIconSize.OnClick := @RgIconSizeClick;
 end;
 
 procedure TForm1.VpNavBar1ItemClick(Sender: TObject; Button: TMouseButton;

components/tvplanit/source/vpnavbar.pas

@@ -1106,19 +1106,23 @@ end;
 
 procedure TVpCustomNavBar.ItemChanged(FolderIndex, ItemIndex: Integer);
 begin
-  InvalidateItem(FolderIndex, ItemIndex);
+  Invalidate;
+//  InvalidateItem(FolderIndex, ItemIndex);
+  (*
   if not (csDestroying in ComponentState) then
     RecreateWnd{$IFDEF LCL}(self){$ENDIF};
+    *)
 end;
 {=====}
 
 procedure TVpCustomNavBar.FolderChanged(FolderIndex: Integer);
 begin
   Unused(FolderIndex);
-
   Invalidate;
+  (*
   if not (csDestroying in ComponentState) then
     RecreateWnd{$IFDEF LCL}(self){$ENDIF};
+   *)
 end;
 {=====}
 

components/tvplanit/source/vpnavbarpainter.pas

@@ -220,7 +220,14 @@ begin
   begin
     case FBackgroundMethod of
       bmNormal:
-        Canvas.Draw(R.Left, R.Top, FBackgroundImage);
+        begin
+          if (FBackgroundImage.Width < WidthOf(R)) or (FBackgroundImage.Height < HeightOf(R))
+          then begin
+            Canvas.Brush.Color := FBackgroundColor;
+            Canvas.FillRect(R.Left, R.Top, R.Right, R.Bottom);
+          end;
+          Canvas.Draw(R.Left, R.Top, FBackgroundImage);
+        end;
       bmStretch:
         Canvas.StretchDraw(R, FBackgroundImage);
       bmTile:
@@ -434,10 +441,12 @@ begin
     Canvas.LineTo(R.Right+1, R.Bottom+1);
     Canvas.LineTo(R.Left-1, R.Bottom+1);
     Canvas.Brush.Color := FBackgroundColor;
+    (*
   end else begin
     Canvas.Pen.Color := FBackgroundColor;
     Canvas.Brush.Color := FBackgroundColor;
     Canvas.Rectangle(R.Left - 1, R.Top - 1, R.Right + 1, R.Bottom + 1);
+    *)
   end;
 end;
 
@@ -572,10 +581,9 @@ begin
     if Assigned(FImages) then begin
       bmp := TBitmap.Create;
       try
-        bmp.Width := FImages.Width;
-        bmp.Height := FImages.Height;
-        FImages.Draw(bmp.Canvas, 0, 0, AItem.IconIndex);
-        Canvas.BrushCopy(AItem.IconRect, bmp, Rect(0, 0, bmp.Width, bmp.Height), bmp.Canvas.Pixels[0, bmp.Height-1]);
+        FImages.GetBitmap(AItem.IconIndex, bmp);
+        bmp.Transparent := true;
+        Canvas.StretchDraw(AItem.IconRect, bmp);
       finally
         bmp.Free;
       end;