tvplanit: Provide image list for the dayview icons.

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

components/tvplanit/source/vpbase.pas

@@ -38,7 +38,7 @@ uses
   {$ELSE}
   Windows, Messages.
   {$ENDIF}
-  Classes, Graphics, Controls, Dialogs, Forms, ExtCtrls, SysUtils,
+  Classes, Graphics, Controls, Dialogs, Forms, ExtCtrls, SysUtils, ImgList,
   VpConst, VpSR;
 
 const
@@ -205,12 +205,14 @@ type
     FBackgroundColor: TColor;
     FColor: TColor;
     FDescription: string;
+    FImageIndex: TImageIndex;
     FIndex: Integer;
     FBitmap: TBitmap;
     procedure SetBackgroundColor(const v: TColor);
     procedure SetBitmap(v: TBitmap);
     procedure SetColor(Value: TColor);
     procedure SetDescription(Value: string);
+    procedure SetImageIndex(Value: TImageIndex);
   public
     constructor Create;
     destructor Destroy; override;
@@ -220,6 +222,7 @@ type
     property Bitmap: TBitmap read FBitmap write SetBitmap;
     property Color: TColor read FColor write SetColor;
     property Description: string read FDescription write SetDescription;
+    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
     property CategoryIndex: Integer read FCategoryIndex;
   end;
 
@@ -753,6 +756,7 @@ begin
   inherited Create;
   FBitmap := TBitmap.Create;
   FBackgroundColor := clWindow;
+  FImageIndex := -1;
 end;
 
 destructor TVpCategoryInfo.Destroy;
@@ -784,6 +788,12 @@ begin
     FDescription := Value;
 end;
 
+procedure TVpCategoryInfo.SetImageIndex(Value: TImageIndex);
+begin
+  if Value <> FImageIndex then
+    FImageIndex := Value;
+end;
+
 
 { TVpTimeRange }
 (*****************************************************************************)

components/tvplanit/source/vpbaseds.pas

@@ -35,11 +35,11 @@ interface
 
 uses
   {$IFDEF LCL}
-  LMessages, LCLProc, LCLIntf, LazFileUtils,
+  LMessages, LCLProc, LCLIntf, LCLVersion, LazFileUtils,
   {$ELSE}
   Windows, Messages,
   {$ENDIF}
-  Classes, Dialogs, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls,
+  Classes, Dialogs, SysUtils, Graphics, Controls, StdCtrls, ExtCtrls, ImgList,
   VpBase, VpData, Forms, VpPrtFmt, VpLocalize;
 
 type
@@ -203,7 +203,17 @@ type
   TVpCustomDataStore = class(TVpComponent)
   private
     FMediaFolder       : String;
+    FImages            : TCustomImageList;
     function IsStoredMediaFolder: Boolean;
+    procedure SetImages(AValue: TCustomImageList);
+
+ {$IFDEF LCL}
+  {$IF LCL_FullVersion >= 1090000}
+  private
+    FImagesWidth: Integer;
+    procedure SetImagesWidth(AValue: Integer);
+  {$IFEND}
+ {$ENDIF}
 
   protected{private}
     FAutoCreate        : Boolean;
@@ -301,6 +311,14 @@ type
       read FCategoryColorMap write FCategoryColorMap;
     property HiddenCategories: TVpCategoryInfo
       read FHiddenCategories write FHiddenCategories;
+    property Images: TCustomImageList
+      read FImages write SetImages;
+   {$IFDEF LCL}
+    {$IF LCL_FullVersion >= 1090000}
+    property ImagesWidth: Integer
+      read FImagesWidth write SetImagesWidth default 0;
+    {$IFEND}
+   {$ENDIF}
     property DefaultEventSound: string
       read FDefaultEventSound write FDefaultEventSound;
     property EnableEventTimer: Boolean
@@ -683,7 +701,24 @@ begin
       NotifyDependents;
   end;
 end;
-{=====}
+
+procedure TVpCustomDataStore.SetImages(AValue: TCustomImageList);
+begin
+  if FImages <> AValue then begin
+    FImages := AValue;
+  end;
+end;
+
+{$IFDEF LCL}
+{$IF LCL_FullVersion >= 1090000}
+procedure TVpCustomDataStore.SetImagesWidth(AValue: Integer);
+begin
+  if FImagesWidth <> AValue then begin
+    FImagesWidth := AValue;
+  end;
+end;
+{$IFEND}
+{$ENDIF}
 
 procedure TVpCustomDataStore.SetResourceID(Value: Integer);
 begin
@@ -701,7 +736,6 @@ begin
       NotifyDependents;
   end;
 end;
-{=====}
 
 procedure TVpCustomDataStore.SetResource(Value: TVpResource);
 begin

components/tvplanit/source/vpdayview.pas

@@ -63,7 +63,7 @@ uses
   {$ELSE}
   Windows, Messages,
   {$ENDIF}
-  Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus,
+  Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus, ImgList,
   VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
 
 type
@@ -189,12 +189,16 @@ type
       FShowRecurringBitmap: Boolean;
       FAlarmBitmap: TBitmap;
       FRecurringBitmap: TBitmap;
+      FAlarmImageIndex: TImageIndex;
+      FRecurringImageIndex: TImageIndex;
       FShowInPrint: Boolean;
       FOwner: TVpLinkableControl;
 
     protected
       procedure SetAlarmBitmap(v: TBitmap);
+      procedure SetAlarmImageIndex(v: TImageIndex);
       procedure SetRecurringBitmap(v: TBitmap);
+      procedure SetRecurringImageIndex(v: TImageIndex);
       procedure SetShowAlarmBitmap(const v: Boolean);
       procedure SetShowCategoryBitmap(const v: Boolean);
       procedure SetShowRecurringBitmap(const v: Boolean);
@@ -206,8 +210,12 @@ type
     published
       property AlarmBitmap: TBitmap
         read FAlarmBitmap write SetAlarmBitmap;
+      property AlarmImageIndex: TImageIndex
+        read FAlarmImageIndex write SetAlarmImageIndex default -1;
       property RecurringBitmap: TBitmap
         read FRecurringBitmap write SetRecurringBitmap;
+      property RecurringImageIndex: TImageIndex
+        read FRecurringImageIndex write SetRecurringImageIndex default -1;
       property ShowAlarmBitmap: Boolean
         read FShowAlarmBitmap write SetShowAlarmBitmap default True;
       property ShowCategoryBitmap : Boolean
@@ -651,6 +659,8 @@ begin
   FOwner := AOwner;
   FAlarmBitmap := TBitmap.Create;
   FRecurringBitmap := TBitmap.Create;
+  FAlarmImageIndex := -1;
+  FRecurringImageIndex := -1;
   FShowAlarmBitmap := True;
   FShowCategoryBitmap := True;
   FShowRecurringBitmap := True;
@@ -671,11 +681,31 @@ begin
     FOwner.Invalidate;
 end;
 
+procedure TVpDayViewIconAttributes.SetAlarmImageIndex(v: TImageIndex);
+begin
+  if FAlarmImageIndex <> v then
+  begin
+    FAlarmImageIndex := v;
+    if Assigned(FOwner) then
+      FOwner.Invalidate;
+  end;
+end;
+
 procedure TVpDayViewIconAttributes.SetRecurringBitmap(v: TBitmap);
 begin
   FRecurringBitmap.Assign(v);
   if Assigned(FOwner) then
-    FOwner.Invalidate
+    FOwner.Invalidate;
+end;
+
+procedure TVpDayViewIconAttributes.SetRecurringImageIndex(v: TImageIndex);
+begin
+  if FRecurringImageIndex <> v then
+  begin
+    FRecurringImageIndex := v;
+    if Assigned(FOwner) then
+      FOwner.Invalidate;
+  end;
 end;
 
 procedure TVpDayViewIconAttributes.SetShowAlarmBitmap(const v: Boolean);

components/tvplanit/source/vpdayviewpainter.pas

@@ -5,7 +5,7 @@ unit VpDayViewPainter;
 interface
 
 uses
-  SysUtils, LCLType, LCLIntf, Types, Classes, Graphics,
+  SysUtils, LCLType, LCLIntf, Types, Classes, Graphics, ImgList,
   VpConst, VPBase, VpData, VpBasePainter, VpDayView;
 
 type
@@ -83,6 +83,7 @@ type
     function CountOverlappingEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer;
     procedure CreateBitmaps;
     function DetermineIconRect(AEventRect: TRect): TRect;
+    function GetImageList: TCustomImageList;
     function GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer;
     procedure DrawAllDayEvents;
     procedure DrawBorders;
@@ -229,6 +230,15 @@ begin
     Result.Right := AEventRect.Right;
 end;
 
+{ Returns the imagelist attached to the datastore of the dayview. }
+function TVpDayViewPainter.GetImageList: TCustomImageList;
+begin
+  if (FDayView <> nil) and (FDayView.Datastore <> nil) then
+    Result := FDayView.Datastore.Images
+  else
+    Result := nil;
+end;
+
 { returns the maximum OLEvents value from all overlapping neighbors }
 function TVpDayViewPainter.GetMaxOLEvents(Event: TVpEvent; const EArray: TVpDvEventArray): Integer;
 var
@@ -1564,20 +1574,29 @@ var
   R: TRect;
   isOverlayed: Boolean;
   grp: TVpResourceGroup;
+  imgList: TCustomImageList;
 begin
   ShowAlarm := False;
   ShowRecurring := False;
   ShowCategory := False;
   ShowCustom := False;
 
+  imgList := GetImageList;
+
   if Event.AlarmSet then begin
-    dvBmpAlarm.Assign(FDayView.IconAttributes.AlarmBitmap);
+    if (FDayView.IconAttributes.AlarmImageIndex > -1) and (imgList <> nil) then
+      imgList.Getbitmap(FDayView.IconAttributes.AlarmImageIndex, dvBmpAlarm)
+    else
+      dvBmpAlarm.Assign(FDayView.IconAttributes.AlarmBitmap);
     ShowAlarm := (dvBmpAlarm.Width <> 0) and (dvBmpAlarm.Height <> 0);
   end;
 
   if Event.RepeatCode <> rtNone then
   begin
-    dvBmpRecurring.Assign(FDayView.IconAttributes.RecurringBitmap);
+    if (FDayView.IconAttributes.RecurringImageIndex > -1) and (imgList <> nil) then
+      imgList.GetBitmap(FDayview.IconAttributes.RecurringImageIndex, dvBmpRecurring)
+    else
+      dvBmpRecurring.Assign(FDayView.IconAttributes.RecurringBitmap);
     ShowRecurring := (dvBmpRecurring.Width <> 0) and (dvBmpRecurring.Height <> 0);
   end;
 
@@ -1593,7 +1612,10 @@ begin
     if Event.Category < 10 then
     begin
       cat := FDayView.Datastore.CategoryColorMap.GetCategory(Event.Category);
-      dvBmpCategory.Assign(cat.Bitmap);
+      if (cat.ImageIndex > -1) and (imgList <> nil) then
+        imgList.GetBitmap(cat.ImageIndex, dvBmpCategory)
+      else
+        dvBmpCategory.Assign(cat.Bitmap);
       {
       w := cat.Bitmap.Width;
       h := cat.Bitmap.Height;

components/tvplanit/source/vpevnteditdlg.pas

@@ -305,48 +305,57 @@ var
 begin
   Unused( State);
 
-  hTxt := Category.Canvas.TextHeight('Tj');
+  lBmp := TBitmap.Create;
-  vMargin := ScaleY(2, DesignTimeDPI);
+  try
-  hMargin := ScaleX(3, DesignTimeDPI);
+    hTxt := Category.Canvas.TextHeight('Tj');
-  hGutter := ScaleX(10, DesignTimeDPI);
+    vMargin := ScaleY(2, DesignTimeDPI);
-  hDist := ScaleX(5, DesignTimeDPI);
+    hMargin := ScaleX(3, DesignTimeDPI);
+    hGutter := ScaleX(10, DesignTimeDPI);
+    hDist := ScaleX(5, DesignTimeDPI);
 
-  with CatColorMap.GetCategory(Index) do begin
+    with CatColorMap.GetCategory(Index) do begin
-    lGutterColor := Color;
+      lGutterColor := Color;
-    lDesc := Description;
+      lDesc := Description;
-    lBmp := Bitmap;
+      lBkColor := BackgroundColor;
-    lBkColor := BackgroundColor;
+      if (ImageIndex > -1) and (FDataStore <> nil) and (FDataStore.Images <> nil) then
+        FDataStore.Images.GetBitmap(ImageIndex, lBmp)
+      else
+        lBmp.Assign(Bitmap);
+    end;
+
+    SavedColor := Category.Canvas.Brush.Color;
+    SavedStyle := Category.Canvas.Brush.Style;
+
+    if State * [odSelected, odFocused] = [] then
+      Category.Canvas.Brush.Color := lBkColor;
+    Category.Canvas.FillRect(ARect);
+
+    Category.Canvas.Brush.Color := lGutterColor;
+    Category.Canvas.Pen.Color := clBlack;
+    ColorRect.Left := ARect.Left + hMargin;
+    ColorRect.Top := ARect.Top + vMargin;
+    ColorRect.Bottom := ARect.Bottom - vMargin;
+    ColorRect.Right := ColorRect.Left + hGutter;
+    Category.Canvas.FillRect(ColorRect);
+    Category.Canvas.Rectangle(ColorRect);
+
+    if lBmp <> nil then begin
+     IconX := ColorRect.Right + hMargin;
+     IconY := (ARect.Top + ARect.Bottom - lBmp.Height) div 2;
+     Category.Canvas.Draw(IconX, IconY, lBmp);
+     inc(ColorRect.Right, lBmp.Width);
+    end;
+
+    ARect.Left := ColorRect.Right + hDist;
+    Category.Canvas.Brush.Style := bsClear;
+    Category.Canvas.TextOut(ARect.Left, (ARect.Top + ARect.Bottom - hTxt) div 2, lDesc);
+
+    Category.Canvas.Brush.Color := SavedColor;
+    Category.canvas.Brush.Style := SavedStyle;
+
+  finally
+    lBmp.Free;
   end;
-
-  SavedColor := Category.Canvas.Brush.Color;
-  SavedStyle := Category.Canvas.Brush.Style;
-
-  if State * [odSelected, odFocused] = [] then
-    Category.Canvas.Brush.Color := lBkColor;
-  Category.Canvas.FillRect(ARect);
-
-  Category.Canvas.Brush.Color := lGutterColor;
-  Category.Canvas.Pen.Color := clBlack;
-  ColorRect.Left := ARect.Left + hMargin;
-  ColorRect.Top := ARect.Top + vMargin;
-  ColorRect.Bottom := ARect.Bottom - vMargin;
-  ColorRect.Right := ColorRect.Left + hGutter;
-  Category.Canvas.FillRect(ColorRect);
-  Category.Canvas.Rectangle(ColorRect);
-
-  if lBmp <> nil then begin
-   IconX := ColorRect.Right + hMargin;
-   IconY := (ARect.Top + ARect.Bottom - lBmp.Height) div 2;
-   Category.Canvas.Draw(IconX, IconY, lBmp);
-   inc(ColorRect.Right, lBmp.Width);
-  end;
-
-  ARect.Left := ColorRect.Right + hDist;
-  Category.Canvas.Brush.Style := bsClear;
-  Category.Canvas.TextOut(ARect.Left, (ARect.Top + ARect.Bottom - hTxt) div 2, lDesc);
-
-  Category.Canvas.Brush.Color := SavedColor;
-  Category.canvas.Brush.Style := SavedStyle;
 end;
 
 procedure TDlgEventEdit.CancelBtnClick(Sender: TObject);