diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index 4fd50e4c6..fcf8075ab 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/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 } (*****************************************************************************) diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index ec6d7514b..8a488b1ca 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/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 diff --git a/components/tvplanit/source/vpdayview.pas b/components/tvplanit/source/vpdayview.pas index d3d475815..7fe372ab9 100644 --- a/components/tvplanit/source/vpdayview.pas +++ b/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); diff --git a/components/tvplanit/source/vpdayviewpainter.pas b/components/tvplanit/source/vpdayviewpainter.pas index 918e84a40..47272536f 100644 --- a/components/tvplanit/source/vpdayviewpainter.pas +++ b/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; diff --git a/components/tvplanit/source/vpevnteditdlg.pas b/components/tvplanit/source/vpevnteditdlg.pas index 0cd751293..88edcae84 100644 --- a/components/tvplanit/source/vpevnteditdlg.pas +++ b/components/tvplanit/source/vpevnteditdlg.pas @@ -305,48 +305,57 @@ var begin Unused( State); - hTxt := Category.Canvas.TextHeight('Tj'); - vMargin := ScaleY(2, DesignTimeDPI); - hMargin := ScaleX(3, DesignTimeDPI); - hGutter := ScaleX(10, DesignTimeDPI); - hDist := ScaleX(5, DesignTimeDPI); + lBmp := TBitmap.Create; + try + hTxt := Category.Canvas.TextHeight('Tj'); + vMargin := ScaleY(2, DesignTimeDPI); + hMargin := ScaleX(3, DesignTimeDPI); + hGutter := ScaleX(10, DesignTimeDPI); + hDist := ScaleX(5, DesignTimeDPI); - with CatColorMap.GetCategory(Index) do begin - lGutterColor := Color; - lDesc := Description; - lBmp := Bitmap; - lBkColor := BackgroundColor; + with CatColorMap.GetCategory(Index) do begin + lGutterColor := Color; + lDesc := Description; + 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);