pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Provide image list for the dayview icons.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6436 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-05-18 09:47:36 +00:00
parent 0dafc729e5
commit 3043e953cc
5 changed files with 156 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
components/tvplanit/source/vpbase.pas
View File

@ -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 }
(*****************************************************************************)

42
components/tvplanit/source/vpbaseds.pas
View File

@ -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

34
components/tvplanit/source/vpdayview.pas
View File

@ -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);

30
components/tvplanit/source/vpdayviewpainter.pas
View File

@ -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;

89
components/tvplanit/source/vpevnteditdlg.pas
View File

@ -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);