SVG Image List

bgracontrols.lpk

@@ -7,7 +7,7 @@
     <CompilerOptions>
       <Version Value="11"/>
       <SearchPaths>
-        <OtherUnitFiles Value="mouseandkeyinput"/>
+        <OtherUnitFiles Value="mouseandkeyinput;bgrasvgimagelistform"/>
         <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)-$(FPCVer)"/>
       </SearchPaths>
       <Parsing>
@@ -34,7 +34,7 @@
     <Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
     <License Value="Modified LGPL"/>
     <Version Major="7"/>
-    <Files Count="62">
+    <Files Count="63">
       <Item1>
         <Filename Value="atshapelinebgra.pas"/>
         <HasRegisterProc Value="True"/>
@@ -336,6 +336,10 @@
         <HasRegisterProc Value="True"/>
         <UnitName Value="BGRASVGImageList"/>
       </Item62>
+      <Item63>
+        <Filename Value="bgrasvgimagelistform/bgrasvgimagelistform.pas"/>
+        <UnitName Value="bgrasvgimagelistform"/>
+      </Item63>
     </Files>
     <LazDoc Paths="fpdoc"/>
     <RequiredPkgs Count="2">

bgracontrols.pas

@@ -20,7 +20,7 @@ uses
   BGRAThemeCheckBox, BGRAThemeRadioButton, BGRAVirtualScreen, 
   ColorSpeedButton, DTAnalogClock, DTAnalogCommon, DTAnalogGauge, 
   dtthemedclock, dtthemedgauge, MaterialColors, BCListBoxEx, BGRASVGTheme, 
-  BGRASVGImageList, LazarusPackageIntf;
+  BGRASVGImageList, bgrasvgimagelistform, LazarusPackageIntf;
 
 implementation
 

bgrasvgimagelist.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, FGL,
-  XMLConf;
+  XMLConf, BGRABitmap, BGRABitmapTypes, BGRASVG;
 
 type
 
@@ -16,8 +16,12 @@ type
 
   TBGRASVGImageList = class(TComponent)
   private
+    FHeight: Integer;
     FItems: TListOfTStringList;
+    FWidth: Integer;
     procedure ReadData(Stream: TStream);
+    procedure SetHeight(AValue: Integer);
+    procedure SetWidth(AValue: Integer);
     procedure WriteData(Stream: TStream);
   protected
     procedure Load(const XMLConf: TXMLConfig);
@@ -31,8 +35,11 @@ type
     procedure Exchange(AIndex1, AIndex2: Integer);
     function Get(AIndex: Integer): String;
     procedure Replace(AIndex: Integer; ASVG: String);
+    function Count: Integer;
+    procedure Draw(AIndex: Integer; ACanvas: TCanvas; ALeft, ATop: Integer);
   published
-
+    property Width: Integer read FWidth write SetWidth;
+    property Height: Integer read FHeight write SetHeight;
   end;
 
 procedure Register;
@@ -52,7 +59,6 @@ var
 begin
   FXMLConf := TXMLConfig.Create(Self);
   try
-    FXMLConf.RootName := 'BGRASVGImageList';
     Stream.Position := 0;
     FXMLConf.LoadFromStream(Stream);
     Load(FXMLConf);
@@ -61,6 +67,18 @@ begin
   end;
 end;
 
+procedure TBGRASVGImageList.SetHeight(AValue: Integer);
+begin
+  if FHeight=AValue then Exit;
+  FHeight:=AValue;
+end;
+
+procedure TBGRASVGImageList.SetWidth(AValue: Integer);
+begin
+  if FWidth=AValue then Exit;
+  FWidth:=AValue;
+end;
+
 procedure TBGRASVGImageList.WriteData(Stream: TStream);
 var
   FXMLConf: TXMLConfig;
@@ -81,7 +99,6 @@ var
 begin
   try
     FItems.Clear;
-    XMLConf.RootName := 'BGRASVGImageList';
     j := XMLConf.GetValue('Count', 0);
     for i:=0 to j-1 do
     begin
@@ -97,7 +114,6 @@ var
   i: integer;
 begin
   try
-    XMLConf.RootName := 'BGRASVGImageList';
     XMLConf.SetValue('Count', FItems.Count);
     for i:=0 to FItems.Count-1 do
       XMLConf.SetValue('Item' + i.ToString + '/SVG', FItems[i].Text);
@@ -115,6 +131,8 @@ constructor TBGRASVGImageList.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FItems := TListOfTStringList.Create(True);
+  FWidth := 16;
+  FHeight := 16;
 end;
 
 destructor TBGRASVGImageList.Destroy;
@@ -151,4 +169,26 @@ begin
   FItems[AIndex].Text := ASVG;
 end;
 
+function TBGRASVGImageList.Count: Integer;
+begin
+  Result := FItems.Count;
+end;
+
+procedure TBGRASVGImageList.Draw(AIndex: Integer; ACanvas: TCanvas; ALeft,
+  ATop: Integer);
+var
+  bmp: TBGRABitmap;
+  svg: TBGRASVG;
+begin
+  bmp := TBGRABitmap.Create(FWidth, FHeight);
+  svg := TBGRASVG.Create(FItems[AIndex].Text);
+  try
+    svg.StretchDraw(bmp.Canvas2D, 0, 0, FWidth, FHeight, True);
+    bmp.Draw(ACanvas, ALeft, ATop, False);
+  finally
+    bmp.Free;
+    svg.Free;
+  end;
+end;
+
 end.

bgrasvgimagelistform/bgrasvgimagelistform.lfm

@@ -0,0 +1,85 @@
+object frmBGRASVGImageListEditor: TfrmBGRASVGImageListEditor
+  Left = 480
+  Height = 240
+  Top = 141
+  Width = 484
+  Caption = 'BGRA SVG Image List'
+  ClientHeight = 240
+  ClientWidth = 484
+  LCLVersion = '2.0.10.0'
+  object ListBox1: TListBox
+    Left = 8
+    Height = 192
+    Top = 40
+    Width = 315
+    ItemHeight = 0
+    OnDrawItem = ListBox1DrawItem
+    OnSelectionChange = ListBox1SelectionChange
+    TabOrder = 0
+  end
+  object btnAdd: TButton
+    Left = 8
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Add'
+    OnClick = btnAddClick
+    TabOrder = 1
+  end
+  object btnRemove: TButton
+    Left = 88
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Remove'
+    Enabled = False
+    OnClick = btnRemoveClick
+    TabOrder = 2
+  end
+  object btnUp: TButton
+    Left = 328
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Up'
+    Enabled = False
+    OnClick = btnUpClick
+    TabOrder = 3
+  end
+  object btnDown: TButton
+    Left = 408
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Down'
+    Enabled = False
+    OnClick = btnDownClick
+    TabOrder = 4
+  end
+  object BCSVGViewerPreview: TBCSVGViewer
+    Left = 328
+    Height = 144
+    Top = 56
+    Width = 144
+    SVGString = '<?xml version="1.0" encoding="utf-8"?>'#13#10'<svg width="75px" xmlns="http://www.w3.org/2000/svg" height="50px"/>'#13#10
+    DrawCheckers = True
+    Color = clWhite
+    ColorOpacity = 128
+    Caption = 'BCSVGViewerPreview'
+  end
+  object btnReplace: TButton
+    Left = 168
+    Height = 25
+    Top = 8
+    Width = 75
+    Caption = 'Replace'
+    Enabled = False
+    OnClick = btnReplaceClick
+    TabOrder = 5
+  end
+  object OpenDialog1: TOpenDialog
+    Filter = 'SVG|*.svg'
+    Left = 166
+    Top = 76
+  end
+end

bgrasvgimagelistform/bgrasvgimagelistform.pas

@@ -0,0 +1,191 @@
+unit bgrasvgimagelistform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, BCSVGViewer,
+  BGRASVGImageList, ComponentEditors, Types, Math;
+
+type
+
+  { TfrmBGRASVGImageListEditor }
+
+  TfrmBGRASVGImageListEditor = class(TForm)
+    BCSVGViewerPreview: TBCSVGViewer;
+    btnAdd: TButton;
+    btnRemove: TButton;
+    btnUp: TButton;
+    btnDown: TButton;
+    btnReplace: TButton;
+    ListBox1: TListBox;
+    OpenDialog1: TOpenDialog;
+    procedure btnAddClick(Sender: TObject);
+    procedure btnDownClick(Sender: TObject);
+    procedure btnRemoveClick(Sender: TObject);
+    procedure btnReplaceClick(Sender: TObject);
+    procedure btnUpClick(Sender: TObject);
+    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
+    procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
+  private
+    FControl: TControl;
+    procedure UpdateListBox;
+    procedure UpdateButtons;
+  public
+    constructor {%H-}Create(AControl: TControl);
+  end;
+
+  { TBGRASVGImageListEditor }
+
+  TBGRASVGImageListEditor = class(TComponentEditor)
+  protected
+    procedure DoShowEditor;
+  public
+    procedure ExecuteVerb(Index: Integer); override;
+    function  GetVerb({%H-}Index: Integer): String; override;
+    function  GetVerbCount: Integer; override;
+  end;
+
+var
+  frmBGRASVGImageListEditor: TfrmBGRASVGImageListEditor;
+
+implementation
+
+{$R *.lfm}
+
+{ TBGRASVGImageListEditor }
+
+procedure TBGRASVGImageListEditor.DoShowEditor;
+var
+  f: TfrmBGRASVGImageListEditor;
+begin
+  f := TfrmBGRASVGImageListEditor.Create(TControl(Component));
+  try
+    f.ShowModal;
+  finally
+    f.Free;
+  end;
+end;
+
+procedure TBGRASVGImageListEditor.ExecuteVerb(Index: Integer);
+begin
+  case Index of
+    0: DoShowEditor;
+  end;
+end;
+
+function TBGRASVGImageListEditor.GetVerb(Index: Integer): String;
+begin
+  Result := 'Assign style';
+end;
+
+function TBGRASVGImageListEditor.GetVerbCount: Integer;
+begin
+  Result := 1;
+end;
+
+{ TfrmBGRASVGImageListEditor }
+
+procedure TfrmBGRASVGImageListEditor.btnAddClick(Sender: TObject);
+var
+  s: TStringList;
+begin
+  if OpenDialog1.Execute then
+  begin
+    s := TStringList.Create;
+    try
+      s.LoadFromFile(OpenDialog1.FileName);
+      TBGRASVGImageList(FControl).Add(s.Text);
+    finally
+      s.Free;
+      UpdateListBox;
+    end;
+  end;
+end;
+
+procedure TfrmBGRASVGImageListEditor.btnDownClick(Sender: TObject);
+begin
+  TBGRASVGImageList(FControl).Exchange(ListBox1.ItemIndex, ListBox1.ItemIndex+1);
+  UpdateListBox;
+end;
+
+procedure TfrmBGRASVGImageListEditor.btnRemoveClick(Sender: TObject);
+begin
+  TBGRASVGImageList(FControl).Remove(ListBox1.ItemIndex);
+  UpdateListBox;
+end;
+
+procedure TfrmBGRASVGImageListEditor.btnReplaceClick(Sender: TObject);
+var
+  s: TStringList;
+begin
+  if OpenDialog1.Execute then
+  begin
+    s := TStringList.Create;
+    try
+      s.LoadFromFile(OpenDialog1.FileName);
+      TBGRASVGImageList(FControl).Replace(ListBox1.ItemIndex, s.Text);
+    finally
+      s.Free;
+      UpdateListBox;
+    end;
+  end;
+end;
+
+procedure TfrmBGRASVGImageListEditor.btnUpClick(Sender: TObject);
+begin
+  TBGRASVGImageList(FControl).Exchange(ListBox1.ItemIndex, ListBox1.ItemIndex-1);
+  UpdateListBox;
+end;
+
+procedure TfrmBGRASVGImageListEditor.ListBox1DrawItem(Control: TWinControl;
+  Index: Integer; ARect: TRect; State: TOwnerDrawState);
+begin
+  //if (Index <> -1) then
+  //  TBGRASVGImageList(FControl).Draw(Index, ListBox1.Canvas, ARect.Left, ARect.Top);
+end;
+
+procedure TfrmBGRASVGImageListEditor.ListBox1SelectionChange(Sender: TObject;
+  User: boolean);
+begin
+  UpdateButtons;
+  if ListBox1.ItemIndex <> -1 then
+    BCSVGViewerPreview.SVGString := TBGRASVGImageList(FControl).Get(ListBox1.ItemIndex);
+end;
+
+procedure TfrmBGRASVGImageListEditor.UpdateListBox;
+var
+  i: integer;
+begin
+  ListBox1.Clear;
+  for i:=0 to TBGRASVGImageList(FControl).Count-1 do
+    ListBox1.Items.Add('Image' + i.ToString);
+  if ListBox1.Count > 0 then
+    ListBox1.ItemIndex := 0;
+  UpdateButtons;
+end;
+
+procedure TfrmBGRASVGImageListEditor.UpdateButtons;
+begin
+  btnUp.Enabled := (ListBox1.Count > 1) and (ListBox1.ItemIndex > 0);
+  btnDown.Enabled := (ListBox1.Count > 1) and (ListBox1.ItemIndex < ListBox1.Count-1);
+  btnRemove.Enabled := (ListBox1.Count > 0) and (ListBox1.ItemIndex <> -1);
+  btnReplace.Enabled := (ListBox1.Count > 0) and (ListBox1.ItemIndex <> -1);
+end;
+
+constructor TfrmBGRASVGImageListEditor.Create(AControl: TControl);
+begin
+  inherited Create(Application);
+
+  FControl  := AControl;
+  ListBox1.ItemHeight := Max(TBGRASVGImageList(FControl).Height, 16);
+  UpdateListBox;
+end;
+
+initialization
+  RegisterComponentEditor(TBGRASVGImageList, TBGRASVGImageListEditor);
+
+end.
+

bgrasvgimagelistform/bgrasvgimagelistproject.lpi

@@ -0,0 +1,82 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="bgrasvgimagelistproject"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bgracontrols"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="bgrasvgimagelistproject.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="bgrasvgimagelistform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frmBGRASVGImageListEditor"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="bgrasvgimagelistproject"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

bgrasvgimagelistform/bgrasvgimagelistproject.lpr

@@ -0,0 +1,22 @@
+program bgrasvgimagelistproject;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, bgrasvgimagelistform
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TfrmBGRASVGImageListEditor, frmBGRASVGImageListEditor);
+  Application.Run;
+end.
+