diff --git a/components/tvplanit/examples/demo/demomain.lfm b/components/tvplanit/examples/demo/demomain.lfm index ada34b0b9..ebeefe3fb 100644 --- a/components/tvplanit/examples/demo/demomain.lfm +++ b/components/tvplanit/examples/demo/demomain.lfm @@ -274,34 +274,6 @@ object MainForm: TMainForm ClientHeight = 504 ClientWidth = 772 TabVisible = False - object VpTaskList1: TVpTaskList - Left = 0 - Height = 462 - Top = 42 - Width = 772 - DataStore = VpBufDSDataStore1 - ControlLink = VpControlLink1 - Color = clWindow - Align = alClient - TabStop = True - TabOrder = 0 - ReadOnly = False - DisplayOptions.CheckBGColor = clWindow - DisplayOptions.CheckColor = cl3DDkShadow - DisplayOptions.CheckStyle = csCheck - DisplayOptions.DueDateFormat = 'dd.MM.yyyy' - DisplayOptions.ShowCompletedTasks = False - DisplayOptions.ShowAll = True - DisplayOptions.ShowDueDate = True - DisplayOptions.OverdueColor = clRed - DisplayOptions.NormalColor = clBlack - DisplayOptions.CompletedColor = clGray - LineColor = clGray - MaxVisibleTasks = 250 - TaskHeadAttributes.Color = clSilver - DrawingStyle = dsFlat - ShowResourceName = True - end object Panel6: TPanel Left = 0 Height = 42 @@ -311,7 +283,7 @@ object MainForm: TMainForm BevelOuter = bvNone ClientHeight = 42 ClientWidth = 772 - TabOrder = 1 + TabOrder = 0 object RbAllTasks: TRadioButton Left = 8 Height = 19 @@ -333,6 +305,37 @@ object MainForm: TMainForm TabOrder = 1 end end + object VpTaskList1: TVpTaskList + Left = 0 + Height = 462 + Top = 42 + Width = 772 + DataStore = VpBufDSDataStore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + Align = alClient + TabStop = True + TabOrder = 1 + ReadOnly = False + DisplayOptions.CheckBGColor = clWindow + DisplayOptions.CheckColor = cl3DDkShadow + DisplayOptions.CheckStyle = csCheck + DisplayOptions.DueDateFormat = 'dd.MM.yyyy' + DisplayOptions.ShowCompletedTasks = False + DisplayOptions.ShowAll = False + DisplayOptions.ShowDueDate = True + DisplayOptions.OverdueColor = clRed + DisplayOptions.NormalColor = clBlack + DisplayOptions.CompletedColor = clGray + LineColor = clGray + MaxVisibleTasks = 250 + TaskHeadAttributes.Color = clSilver + TaskHeadAttributes.Font.Height = -12 + DrawingStyle = ds3d + ShowResourceName = True + end end object TabContacts: TTabSheet Caption = 'Contacts' diff --git a/components/tvplanit/examples/xmldatastore/unit1.lfm b/components/tvplanit/examples/xmldatastore/unit1.lfm index 1b3f5f113..04dc7cf43 100644 --- a/components/tvplanit/examples/xmldatastore/unit1.lfm +++ b/components/tvplanit/examples/xmldatastore/unit1.lfm @@ -190,8 +190,6 @@ object Form1: TForm1 DataStore = VpXmlDatastore1 ControlLink = VpControlLink1 Color = clWindow - Font.Height = -12 - ParentFont = False Align = alClient TabStop = True TabOrder = 2 diff --git a/components/tvplanit/source/vpbaseds.pas b/components/tvplanit/source/vpbaseds.pas index b8d493841..9e1d242e7 100644 --- a/components/tvplanit/source/vpbaseds.pas +++ b/components/tvplanit/source/vpbaseds.pas @@ -316,18 +316,17 @@ type procedure CMEnter(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message CM_ENTER; procedure CMExit(var Msg: {$IFDEF DELPHI}TMessage{$ELSE}TLMessage{$ENDIF}); message CM_EXIT; public - constructor Create (AOwner : TComponent); override; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function GetLastPrintLine : Integer; - function GetControlType : TVpItemType; virtual; abstract; - procedure RenderToCanvas (RenderCanvas: TCanvas; RenderIn: TRect; + function GetLastPrintLine: Integer; + function GetControlType: TVpItemType; virtual; abstract; + procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; - StartLine: Integer; StopLine: Integer; UseGran: TVpGranularity; + StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); virtual; abstract; - procedure LinkHandler(Sender: TComponent; - NotificationType: TVpNotificationType; const Value: Variant); - virtual; abstract; - property ReadOnly : Boolean read FReadOnly write FReadOnly; + procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; + const Value: Variant); virtual; abstract; + property ReadOnly: Boolean read FReadOnly write FReadOnly; published property PopupMenu; property DataStore: TVpCustomDataStore read FDataStore write SetDataStore; @@ -1227,6 +1226,7 @@ begin Inc(I); end; end; + FPrinter := TVpPrinter.Create (Self); FLocalization := TVpLocalization.Create; end; diff --git a/components/tvplanit/source/vpcalendar.pas b/components/tvplanit/source/vpcalendar.pas index d74b3f464..f53739c60 100644 --- a/components/tvplanit/source/vpcalendar.pas +++ b/components/tvplanit/source/vpcalendar.pas @@ -761,7 +761,7 @@ begin if csLoading in ComponentState then Exit; - calRecalcSize (False); + calRecalcSize(False); Invalidate; end; {=====} @@ -1448,372 +1448,6 @@ begin painter.Free; end; end; -(* -var - R, C: Integer; - I: Integer; - SatCol: Integer; - SunCol: Integer; - DOW: TVpDayType; - Y, M, D: Word; - lBadDate: Boolean; - lDate: TDateTime; - RealWidth: Integer; - RealHeight: Integer; - RealLeft: Integer; - RealRight: Integer; - RealTop: Integer; - RealBottom: Integer; - BevelHighlight: TColor; - BevelShadow: TColor; - InactiveDayColor: TColor; - MonthYearColor: TColor; - DayNameColor: TColor; - LineColor: TColor; - EventDayColor: TColor; - DayColor: TColor; - RealColor: TColor; - WeekendColor: TColor; - - procedure SetMeasurements; - begin - RealWidth := TPSViewportWidth (Angle, RenderIn); - RealHeight := TPSViewportHeight (Angle, RenderIn); - RealLeft := TPSViewportLeft (Angle, RenderIn); - RealRight := TPSViewportRight (Angle, RenderIn); - RealTop := TPSViewportTop (Angle, RenderIn); - RealBottom := TPSViewportBottom (Angle, RenderIn); - - if RenderDate = 0 then - RenderDate := FDate; - end; - - procedure DrawDate; - var - R: TRect; - S: string; - begin - if FDateFormat = dfLong then - if cdoShowYear in FOptions then - S := FormatDateTime('mmmm yyyy', RenderDate) - else - S := FormatDateTime('mmmm', RenderDate) - else - if cdoShowYear in FOptions then - S := FormatDateTime('mmm yyyy', RenderDate) - else - S := FormatDateTime('mmm', RenderDate); - {$IF FPC_FULLVERSION < 30000} - S := SysToUTF8(S); - {$ENDIF} - - R := Rect (clRowCol[0, 1].Left + RealLeft, - clRowCol[0, 1].Top + RealTop, - clRowCol[0, 1].Right + RealLeft, - clRowCol[0, 1].Bottom + RealTop); - R.Right := clRowCol[0, 6].Left + RealLeft; - - {switch to short date format if string won't fit} - if FDateFormat = dfLong then - if RenderCanvas.TextWidth(S) > R.Right-R.Left then - {$IF FPC_FULLVERSION >= 30000} - S := FormatDateTime('mmm yyyy', RenderDate); - {$ELSE} - S := SysToUTF8(FormatDateTime('mmm yyyy', RenderDate)); - {$ENDIF} - - RenderCanvas.Font.Color := MonthYearColor; - if Assigned(FOnDrawDate) then - FOnDrawDate(Self, RenderDate, R) - else - TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, R, S); - end; - - procedure DrawDayNames; - var - I: Integer; - S: string; - DrawRect: TRect; - begin - {draw the day name column labels} - RenderCanvas.Font.Color := DayNameColor; - I := 0; - DOW := FWeekStarts; - repeat - {record columns for weekends} - if DOW = dtSaturday then - SatCol := I; - if DOW = dtSunday then - SunCol := I; - - {get the day name} - if cdoShortNames in Options then begin - if FDayNameWidth < 1 then - S := ShortDayNames[Ord(DOW)+1] - else - S := Copy(ShortDayNames[Ord(DOW)+1], 1, FDayNameWidth) - end else begin - if FDayNameWidth < 1 then - S := LongDayNames[Ord(DOW)+1] - else - S := Copy(LongDayNames[Ord(DOW)+1], 1, FDayNameWidth) - end; - {$IF FPC_FULLVERSION < 30000} - S := SysToUTF8(S); - {$ENDIF} - - {draw the day name above each column} - DrawRect := Rect(clRowCol[1, I].Left + RealLeft, - clRowCol[1, I].Top + RealTop, - clRowCol[1, I].Right + RealLeft, - clRowCol[1, I].Bottom + RealTop); - TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S); - Inc(I); - if DOW < High(DOW) then - Inc(DOW) - else - DOW := Low(DOW); - until DOW = WeekStarts; - end; - - procedure DrawLine; - begin -// if (not Ctl3D) then begin - RenderCanvas.Pen.Color := LineColor; - TPSMoveTo (RenderCanvas, Angle, RenderIn, - RealLeft, clRowCol[1,0].Bottom-3 + RealTop); - TPSLineTo (RenderCanvas, Angle, RenderIn, - RealRight, clRowCol[1,0].Bottom-3 + RealTop); -{ end else if Ctl3D then begin - RenderCanvas.Pen.Color := BevelHighlight; - TPSMoveTo (RenderCanvas, Angle, RenderIn, - RealLeft, clRowCol[1,0].Bottom-3 + RealTop); - TPSLineTo (RenderCanvas, Angle, RenderIn, - RealRight, clRowCol[1,0].Bottom-3 + RealTop); - RenderCanvas.Pen.Color := BevelShadow; - TPSMoveTo (RenderCanvas, Angle, RenderIn, - RealLeft, clRowCol[1,0].Bottom-2 + RealTop); - TPSLineTo (RenderCanvas, Angle, RenderIn, - RealRight, clRowCol[1,0].Bottom-2 + RealTop); - end; } - end; - - procedure DrawDay(R, C, I: Integer; Grayed: Boolean); - var - Cl: TColor; - OldIdx: Integer; - NewIdx: Integer; - S: string[10]; - DrawRect: TRect; - TH: Integer; - - begin - {avoid painting day number under buttons} - if cdoShowRevert in FOptions then - if (R = 8) and (C >= 3) then - Exit; - if cdoShowToday in FOptions then - if (R = 8) and (C >= 5) then - Exit; - - {convert to a string and draw it centered in its rectangle} - S := IntToStr(clCalendar[I]); - - if Grayed then - RenderCanvas.Font.Color := InactiveDayColor; - - if not Grayed or (cdoShowInactive in FOptions) then begin - NewIdx := ((R-2) * 7) + Succ(C); - OldIdx := clFirst + Pred(clDay); - if Assigned(FOnGetHighlight) then begin - Cl := RenderCanvas.Font.Color; - FOnGetHighlight(Self, RenderDate+(NewIdx-OldIdx), Cl); - RenderCanvas.Font.Color := Cl; - end; - if Assigned(FOnDrawItem) then - FOnDrawItem(Self, RenderDate+(NewIdx-OldIdx), clRowCol[R,C]) - else if clRowCol[R, C].Top <> 0 then begin - DrawRect := Rect (clRowCol[R, C].Left + RealLeft, - clRowCol[R, C].Top + RealTop, - clRowCol[R, C].Right + RealLeft, - clRowCol[R, C].Bottom + RealTop); - TH := RenderCanvas.TextHeight (S); - if TH < DrawRect.Bottom - DrawRect.Top then - DrawRect.Top := DrawRect.Top + - ((DrawRect.Bottom - DrawRect.Top) - TH) div 2; - TPSCenteredTextOut(RenderCanvas, Angle, RenderIn, DrawRect, S); - end; - end; - end; - - procedure DrawFocusBox; - var - R: TRect; - S: string[10]; - begin - S := IntToStr(clDay); - - { set highlight color and font style for days with events } - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold]; - lBadDate := false; - - if (DataStore <> nil) and (DataStore.Resource <> nil) then begin - DecodeDate(RenderDate, Y, M, D); - try - {$IFDEF VERSION6} - if not TryEncodeDate (Y, M, clDay, lDate) then - lBadDate := true; - {$ELSE} - lDate := EncodeDate(Y, M, clDay); - {$ENDIF} - except - lBadDate := true; - end; - - if (not lBadDate) and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0) - then begin - RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline]; - RenderCanvas.Font.Color := EventDayColor; - end else - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline]; - end; - - R := calGetCurrentRectangle; - R.Left := R.Left + RealLeft; - R.Top := R.Top + RealTop; - R.Right := R.Right + RealLeft; - R.Bottom := R.Bottom + RealTop; - - R := TPSRotateRectangle (Angle, RenderIn, R); - if not DisplayOnly then begin - {$IFNDEF LCL} - if Focused then - DrawButtonFace (RenderCanvas, R, 1, bsNew, True, True, False) - else - DrawButtonFace (RenderCanvas, R, 1, bsNew, True, False, False); - {$ENDIF} - R := calGetCurrentRectangle; - R.Left := R.Left + RealLeft; - R.Top := R.Top + RealTop; - R.Right := R.Right + RealLeft; - R.Bottom := R.Bottom + RealTop; - TPSCenteredTextOut (RenderCanvas, Angle, RenderIn, R, S); - end; - end; - -var - Row: TRowArray; - Col: TColArray; - -begin - if DisplayOnly then begin - BevelHighlight := clBlack; - BevelShadow := clBlack; - InactiveDayColor := clSilver; - MonthYearColor := clBlack; - DayNameColor := clBlack; - LineColor := clBlack; - EventDayColor := clBlack; - DayColor := clBlack; - RealColor := clWhite; - WeekendColor := $5f5f5f; - end else begin - BevelHighlight := clBtnHighlight; - BevelShadow := clBtnShadow; - InactiveDayColor := FColors.InactiveDays; - MonthYearColor := FColors.MonthAndYear; - DayNameColor := FColors.DayNames; - LineColor := Font.Color; - EventDayColor := FColors.EventDays; - DayColor := FColors.Days; - RealColor := Color; - WeekendColor := FColors.WeekEnd; - end; - - calRebuildCalArray (RenderDate); - - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Width := 1; - RenderCanvas.Pen.Mode := pmCopy; - RenderCanvas.Brush.Style := bsSolid; - - RenderCanvas.Lock; - try - SetMeasurements; - - RenderCanvas.Font.Assign (Font); - - if (RealRight - RealLeft <> FLastRenderX) or - (RealBottom - RealTop <> FLastRenderY) - then begin - FLastRenderX := RealRight - RealLeft; - FLastRenderY := RealBottom - RealTop; - CalculateSizes (RenderCanvas, Angle, RenderIn, Row, Col, DisplayOnly); - end; - RenderCanvas.Brush.Color := RealColor; - RenderCanvas.FillRect(RenderIn); - - {draw the month and year at the top of the calendar} - DrawDate; - - {draw the days of the week} - DrawDayNames; - - {draw line under day names} - DrawLine; - - {draw each day} - I := 1; - for R := 2 to 8 do - for C := 0 to 6 do begin - if ((C = SatCol) and (cdoHighlightSat in Options)) or - ((C = SunCol) and (cdoHighlightSun in Options)) - then - RenderCanvas.Font.Color := WeekendColor - else - RenderCanvas.Font.Color := DayColor; - - { set highlight color and font style for days with events } - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold]; - lBadDate := false; - if (DataStore <> nil) and (DataStore.Resource <> nil) then begin - DecodeDate(RenderDate, Y, M, D); - try begin - {$IFDEF VERSION6} - if not TryEncodeDate (Y, M, clCalendar[I], lDate) then - lBadDate := True; - {$ELSE} - if clCalendar[I] > DaysInMonth(Y, M) then - lDate := EncodeDate(Y, M, DaysInMonth(Y, M)) - else - lDate := EncodeDate(Y, M, clCalendar[I]); - {$ENDIF} - end; - except - lBadDate := true; - end; - - if (not lBadDate) and (DataStore.Resource.Schedule.EventCountByDay(lDate) > 0) - then begin - RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsBold, fsUnderline]; - RenderCanvas.Font.Color := EventDayColor; - end else - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsBold, fsUnderline]; - end; - DrawDay(R, C, I, (I < clFirst) or (I > clLast)); - Inc(I); - end; - - RenderCanvas.Font.Color := DayColor; - if not Assigned(FOnDrawItem) then - if not (cdoHideActive in FOptions) then - DrawFocusBox; - finally - RenderCanvas.Unlock; - end; -end; -{=====} -*) procedure TVpCustomCalendar.SetBorderStyle(Value: TBorderStyle); begin diff --git a/components/tvplanit/source/vpcontactgrid.pas b/components/tvplanit/source/vpcontactgrid.pas index 038fa44e6..82425eddb 100644 --- a/components/tvplanit/source/vpcontactgrid.pas +++ b/components/tvplanit/source/vpcontactgrid.pas @@ -620,1221 +620,6 @@ begin end; end; - (* -var - SaveBrushColor : TColor; - SavePenStyle : TPenStyle; - SavePenColor : TColor; - PhoneLblWidth : Integer; - StartContact : Integer; - - RealWidth : Integer; - RealHeight : Integer; - RealLeft : Integer; - RealRight : Integer; - RealTop : Integer; - RealBottom : Integer; - RealColumnWidth : Integer; - Rgn : HRGN; - - RealColor : TColor; - SizingBarColor : TColor; - BevelDarkShadow : TColor; - BevelShadow : TColor; - BevelHighlight : TColor; - BevelFace : TColor; - RealBarColor : TColor; - RealContactHeadAttrColor : TColor; - - procedure Clear; - var - I: Integer; - begin - { clear Client Area } - RenderCanvas.Brush.Color := RealColor; - RenderCanvas.FillRect(RenderIn); - - { clear the vertical bar array } - for I := 0 to pred(MaxColumns) do begin - if cgBarArray[I].Index = -1 then - Break; - cgBarArray[I].Rec := Rect(-1, -1, -1, -1); - cgBarArray[I].Index := -1; - end; - - { initialize the contact array at runtime } - if not (csDesigning in ComponentState) - and (DataStore <> nil) - and (DataStore.Resource <> nil) - then begin - SetLength(cgContactArray, DataStore.Resource.Contacts.Count); - for I := 0 to pred(Length(cgContactArray)) do begin - with cgContactArray[I] do begin - Index := -1; - Contact := nil; - WholeRect := Rect(-1, -1, -1, -1); - HeaderRect := Rect(-1, -1, -1, -1); - AddressRect := Rect(-1, -1, -1, -1); - CSZRect := Rect(-1, -1, -1, -1); - Phone1Rect := Rect(-1, -1, -1, -1); - Phone2Rect := Rect(-1, -1, -1, -1); - Phone3Rect := Rect(-1, -1, -1, -1); - Phone4Rect := Rect(-1, -1, -1, -1); - Phone5Rect := Rect(-1, -1, -1, -1); - end; - end; - end; - end; - {--} - - procedure SetMeasurements; - begin - RealWidth := TPSViewportWidth (Angle, RenderIn); - RealHeight := TPSViewportHeight (Angle, RenderIn); - RealLeft := TPSViewportLeft (Angle, RenderIn); - RealRight := TPSViewportRight (Angle, RenderIn); - RealTop := TPSViewportTop (Angle, RenderIn); - RealBottom := TPSViewportBottom (Angle, RenderIn); - end; - - procedure DrawVerticalBars; - var - BarPos, BarCount, I: Integer; - begin - { if the component is sufficiently small then no sense in painting it } - if (Height < 20) then exit; - - { draw vertical bars } - RenderCanvas.Pen.Color := RealBarColor; - RenderCanvas.Pen.Style := psSolid; - BarPos := RealLeft + 2 + RealColumnWidth + ExtraBarWidth; - BarCount := 0; - while (BarPos < RealRight) and (BarCount < Pred (MaxColumns)) do begin - cgBarArray[BarCount].Rec := Rect(BarPos - ExtraBarWidth, RealTop, - BarPos - ExtraBarWidth + FBarWidth, RealBottom); - cgBarArray[BarCount].Index := BarCount; - for I := 1 to BarWidth do begin - TPSMoveTo (RenderCanvas, Angle, RenderIn, - BarPos, RealTop + 2 + TextMargin * 2); - TPSLineTo (RenderCanvas, Angle, RenderIn, - BarPos, RealBottom - TextMargin * 2); - Inc(BarPos); - end; - Inc(BarPos, RealColumnWidth); - Inc(BarCount); - end; - - { if the columns are being resized, then draw the temporary resizing bars } - if cgGridState = gsColSizing then begin - { clear sizing bar array } - for I := 0 to pred(MaxColumns) do begin - if cgResizeBarArray[I].Index = -1 then - Break; - cgResizeBarArray[I].Rec := Rect(-1, -1, -1, -1); - cgResizeBarArray[I].Index := -1; - end; - { draw sizing bars } - RenderCanvas.Pen.Color := SizingBarColor; - RenderCanvas.Pen.Style := psDash; - BarPos := RealLeft + 2 + cgNewColWidth + ExtraBarWidth; - BarCount := 0; - while (BarPos < Width) and (BarCount < pred(MaxColumns)) do begin - cgResizeBarArray[BarCount].Index := BarCount; - cgResizeBarArray[BarCount].Rec := Rect( - BarPos - ExtraBarWidth, - RealTop, - BarPos - ExtraBarWidth + FBarWidth, - RealBottom - ); - for I := 1 to BarWidth do begin - TPSMoveTo (RenderCanvas, Angle, RenderIn, - RealLeft + BarPos, - RealTop + 2 + TextMargin * 2); - TPSLineTo (RenderCanvas, Angle, RenderIn, - RealLeft + BarPos, - RealBottom - TextMargin * 2); - Inc(BarPos); - end; - Inc(BarPos, cgNewColWidth); - Inc(BarCount); - end; - RenderCanvas.Pen.Style := psSolid; - end; - end; - {--} - - procedure DrawContacts; - var - Anchor: TPoint; - I, J: Integer; - Str: string; - TmpBmp: TBitmap; - TmpCon: TVpContact; - Col, RecsInCol: Integer; - HeadRect, AddrRect, CSZRect, Phone1Rect, Phone2Rect, Phone3Rect: TRect; - Phone4Rect, Phone5Rect, WholeRect, CompanyRect, EMailRect: TRect; - TmpBmpRect: TRect; - TextColWidth: Integer; - TextXOffset: Integer; - TextYOffset: Integer; - oldCol1RecCount: Integer; - begin - oldCol1RecCount := cgCol1RecCount; - - FVisibleContacts := 0; - cgCol1RecCount := 0; - TextXOffset := 0; - TextYOffset := 0; - { if the component is sufficiently small then no sense in painting it } - if (Height < 20) then exit; - { don't paint contacts at designtime or if the data connection is invalid } - - if (csDesigning in ComponentState) - or (DataStore = nil) - or (DataStore.Resource = nil) then - Exit; - - { create a temporary bitmap for painting the items } - TmpBmp := TBitmap.Create; - try - if (Angle = ra0) or (Angle = ra180) then begin - TmpBmp.Width := RealColumnWidth - (TextMargin * 4); - TmpBmp.Height := RealHeight - (TextMargin * 2); - TextColWidth := TmpBmp.Width; - end else begin - TmpBmp.Height := RealColumnWidth - (TextMargin * 4); - TmpBmp.Width := RealHeight - (TextMargin * 2); - TextColWidth := TmpBmp.Height; - end; - TmpBmpRect := Rect (0, 0, TmpBmp.Width, TmpBmp.Height); - - TmpBmp.Canvas.Font.Assign(Font); - - { Calculate Phone Lbl Width } - PhoneLblWidth := TmpBmp.Canvas.TextWidth(RSEmail); - for I := 0 to 7 do begin - Str := PhoneLabel(TVpPhoneType(I)) + ': '; - J := TmpBmp.Canvas.TextWidth(Str); - if J > PhoneLblWidth then - PhoneLblWidth := J; - end; - - Col := 1; - { clear the bitmap } - TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height)); - - { sort the records } - DataStore.Resource.Contacts.Sort; - - { Set the anchor starting point } - case Angle of - ra0 : - Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2); - ra90 : - Anchor := Point(2 + TextMargin * 2, 2 + TextMargin * 2); - ra180 : - Anchor := Point( - RenderIn.Right - RenderIn.Left - TmpBmp.Width - 2 - TextMargin * 2, - TmpBmp.Height - 2 - TextMargin * 2 - ); - ra270 : - Anchor := Point( - 2 + TextMargin * 2, - RenderIn.Bottom - RenderIn.Top - TmpBmp.Height - 2 - TextMargin * 2 - ); - end; - RecsInCol := 0; - - for I := StartContact to pred(DataStore.Resource.Contacts.Count) do begin - TmpCon := DataStore.Resource.Contacts.GetContact(I); - if (TmpCon <> nil) then begin - { Clear bmp canvas } - TmpBmp.Canvas.Brush.Color := RealColor; - TmpBmp.Canvas.FillRect(Rect(0, 0, TmpBmp.Width, TmpBmp.Height)); - - cgContactArray[I].Contact := TmpCon; - { start building the WholeRect and build the HeaderRect} - TmpBmp.Canvas.Pen.Color := BevelDarkShadow; - TmpBmp.Canvas.Brush.Style := bsSolid; - TmpBmp.Canvas.Font.Assign(FContactHeadAttr.Font); - case Angle of - ra0: - begin - WholeRect.TopLeft := Point(0, 0); - HeadRect.TopLeft := Point(TextMargin, 0); - HeadRect.BottomRight := Point( - TmpBmp.Width, - HeadRect.Top + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2 - ); - WholeRect.BottomRight := HeadRect.BottomRight; - end; - ra90: - begin - HeadRect.TopLeft := Point( - TmpBmpRect.Right - TextMargin - TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2, - 0 - ); - HeadRect.BottomRight := Point(TmpBmpRect.Right, TmpBmp.Height); - WholeRect.TopLeft := HeadRect.TopLeft; - WholeRect.BottomRight := HeadRect.BottomRight; - end; - ra180: - begin - WholeRect.BottomRight := Point(TmpBmp.Width, TmpBmp.Height); - HeadRect.TopLeft := Point( - TextMargin, - TmpBmpRect.Bottom - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin - ); - HeadRect.BottomRight := Point( - TmpBmp.Width, - TmpBmp.Height - TextMargin div 2 - ); - WholeRect.TopLeft := HeadRect.TopLeft; - end; - ra270: - begin - WholeRect.TopLeft := Point(0, 0); - HeadRect.TopLeft := Point(0, TextMargin); - HeadRect.BottomRight := Point( - TextMargin + TmpBmp.Canvas.TextHeight(VpProductName) + TextMargin div 2, - TmpBmp.Height - ); - WholeRect.BottomRight := HeadRect.BottomRight; - end; - end; - { assemble the header string } - Str := AssembleName(TmpCon); - { if the name isn't empty then paint all of the contact information } - if Str > '' then begin - { paint the header cell's background } - if (Angle = ra0) or (Angle = ra180) then - Str := GetDisplayString (TmpBmp.Canvas, Str, 2, - WidthOf(HeadRect) - TextMargin) - else - Str := GetDisplayString (TmpBmp.Canvas, Str, 2, - HeightOf(HeadRect) - TextMargin); - TmpBmp.Canvas.Brush.Color := RealContactHeadAttrColor; - TmpBmp.Canvas.FillRect (HeadRect); - { paint the header cell's border } - if FContactHeadAttr.Bordered then begin - TmpBmp.Canvas.Pen.Style := psSolid; - {$IFDEF VERSION5} - TmpBmp.Canvas.Rectangle (HeadRect); - {$ELSE} - TmpBmp.Canvas.Rectangle (HeadRect.Left, HeadRect.Top, - HeadRect.Right, HeadRect.Bottom); - {$ENDIF} - end; - { paint the header cell's text } - case Angle of - ra90 : begin - TextXOffset := HeadRect.Right - HeadRect.Left - TextMargin div 2; - TextYOffset := TextMargin div 3; - end; - ra180 : begin - TextXOffset := HeadRect.Right - HeadRect.Left - TextMargin; - TextYOffset := HeadRect.Bottom - HeadRect.Top - TextMargin div 3; - end; - ra270 : begin - TextXOffset := TextMargin div 2; - TextYOffset := HeadRect.Bottom - HeadRect.Top - TextMargin div 3; - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - HeadRect.Left + (TextMargin div 2) + TextXOffset, - HeadRect.Top + (TextMargin div 3) + TextYOffset, Str); - - { restore font and colors } - TmpBmp.Canvas.Font.Assign(Font); - TmpBmp.Canvas.Brush.Color := RealColor; - TmpBmp.Canvas.Pen.Color := BevelDarkShadow; - TmpBmp.Canvas.Pen.Style := psSolid; - - { do Company } - Str := TmpCon.Company; - if Str <> '' then begin - case Angle of - ra0 : begin - CompanyRect.TopLeft := Point (TextMargin, - WholeRect.Bottom + (TextMargin div 2)); - CompanyRect.BottomRight := Point(TmpBmp.Width, CompanyRect.Top - + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := CompanyRect.Bottom; - end; - ra90 : begin - CompanyRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - CompanyRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := CompanyRect.Left; - end; - ra180 : begin - CompanyRect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - CompanyRect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := CompanyRect.Top; - end; - ra270 : begin - CompanyRect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - CompanyRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := CompanyRect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - TextMargin * 2); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - CompanyRect.Left + TextMargin, - CompanyRect.Top + (TextMargin div 2), - Str); - end; - - { do address... } - if TmpCon.Address <> '' then begin - case Angle of - ra0 : begin - AddrRect.TopLeft := Point (TextMargin, - WholeRect.Bottom + (TextMargin div 2)); - AddrRect.BottomRight := Point (TmpBmp.Width, - AddrRect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := AddrRect.Bottom; - Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2, - WidthOf(AddrRect) - TextMargin); - end; - ra90 : begin - AddrRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - AddrRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := AddrRect.Left; - Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2, - HeightOf (AddrRect) - TextMargin); - end; - ra180 : begin - AddrRect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - AddrRect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := AddrRect.Top; - Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2, - WidthOf(AddrRect) - TextMargin); - end; - ra270 : begin - AddrRect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - AddrRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := AddrRect.Right; - Str := GetDisplayString(TmpBmp.Canvas, TmpCon.Address, 2, - TextColWidth - TextMargin * 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - AddrRect.Left + TextMargin, - AddrRect.Top + (TextMargin div 2), Str); - end; - - { do City, State, Zip } - Str := TmpCon.City; - if Str <> '' then - Str := Str + ', ' + TmpCon.State - else - Str := TmpCon.State; - if Str <> '' then - Str := Str + ' ' + TmpCon.Zip - else - Str := TmpCon.Zip; - if Str <> '' then begin - case Angle of - ra0 : begin - CSZRect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - CSZRect.BottomRight := Point(TmpBmp.Width, CSZRect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := CSZRect.Bottom; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - TextMargin * 2); - end; - ra90 : begin - CSZRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - CSZRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Bottom := CSZRect.Bottom; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - TextMargin * 2); - WholeRect.Left := CSZRect.Left; - end; - ra180 : begin - CSZRect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - (TextMargin div 2)); - CSZRect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := CSZRect.Top; - end; - ra270 : begin - CSZRect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - CSZRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := CSZRect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - TextMargin * 2); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - CSZRect.Left + TextMargin, - CSZRect.Top + (TextMargin div 2), Str); - end; - - { do Phone1 } - Str := TmpCon.Phone1; - if Str <> '' then begin - case Angle of - ra0 : begin - Phone1Rect.TopLeft := - Point (TextMargin, - WholeRect.Bottom + (TextMargin div 2)); - Phone1Rect.BottomRight := - Point (TmpBmp.Width, - Phone1Rect.Top + - TmpBmp.Canvas.TextHeight (VpProductName) + - (TextMargin div 2)); - WholeRect.Bottom := Phone1Rect.Bottom; - Str := GetDisplayString (TmpBmp.Canvas, Str, 2, - TextColWidth - (TextMargin * 2) - - PhoneLblWidth); - end; - ra90 : begin - Phone1Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - Phone1Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := Phone1Rect.Left; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - end; - ra180 : begin - Phone1Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - Phone1Rect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := Phone1Rect.Top; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - end; - ra270 : begin - Phone1Rect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - Phone1Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := Phone1Rect.Right; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone1Rect.Left + TextMargin, - Phone1Rect.Top + (TextMargin div 2), - PhoneLabel(TVpPhoneType(TmpCon.PhoneType1)) + ': '); - case Angle of - ra0 : begin - Phone1Rect.Left := Phone1Rect.Left + PhoneLblWidth; - Phone1Rect.Top := Phone1Rect.Top + (TextMargin div 2); - end; - ra90 : begin - Phone1Rect.Top := Phone1Rect.Top + PhoneLblWidth; - Phone1Rect.Left := Phone1Rect.Left + (TextMargin); - end; - ra180 : begin - Phone1Rect.Left := Phone1Rect.Left - PhoneLblWidth; - Phone1Rect.Top := Phone1Rect.Top + (TextMargin div 2); - end; - ra270 : begin - Phone1Rect.Top := Phone1Rect.Top - PhoneLblWidth; - Phone1Rect.Left := Phone1Rect.Left + (TextMargin div 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone1Rect.Left, - Phone1Rect.Top, Str); - end; - - { do Phone2 } - Str := TmpCon.Phone2; - if Str <> '' then begin - case Angle of - ra0 : begin - Phone2Rect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - Phone2Rect.BottomRight := Point(TmpBmp.Width, Phone2Rect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := Phone2Rect.Bottom; - end; - ra90 : begin - Phone2Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - Phone2Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := Phone2Rect.Left; - end; - ra180 : begin - Phone2Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - Phone2Rect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := Phone2Rect.Top; - end; - ra270 : begin - Phone2Rect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - Phone2Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := Phone2Rect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone2Rect.Left + TextMargin, - Phone2Rect.Top + (TextMargin div 2), - PhoneLabel(TVpPhoneType(TmpCon.PhoneType2)) + ': '); - case Angle of - ra0 : begin - Phone2Rect.Left := Phone2Rect.Left + PhoneLblWidth; - Phone2Rect.Top := Phone2Rect.Top + (TextMargin div 2); - end; - ra90 : begin - Phone2Rect.Top := Phone2Rect.Top + PhoneLblWidth; - Phone2Rect.Left := Phone2Rect.Left + (TextMargin); - end; - ra180 : begin - Phone2Rect.Left := Phone2Rect.Left - PhoneLblWidth; - Phone2Rect.Top := Phone2Rect.Top + (TextMargin div 2); - end; - ra270 : begin - Phone2Rect.Top := Phone2Rect.Top - PhoneLblWidth; - Phone2Rect.Left := Phone2Rect.Left + (TextMargin div 2); - end; - end; - - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone2Rect.Left, - Phone2Rect.Top, Str); - end; - - { do Phone3 } - Str := TmpCon.Phone3; - if Str <> '' then begin - case Angle of - ra0 : begin - Phone3Rect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - Phone3Rect.BottomRight := Point(TmpBmp.Width, Phone3Rect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := Phone3Rect.Bottom; - end; - ra90 : begin - Phone3Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - Phone3Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := Phone3Rect.Left; - end; - ra180 : begin - Phone3Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - Phone3Rect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := Phone3Rect.Top; - end; - ra270 : begin - Phone3Rect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - Phone3Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := Phone3Rect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone3Rect.Left + TextMargin, - Phone3Rect.Top + (TextMargin div 2), - PhoneLabel(TVpPhoneType(TmpCon.PhoneType3)) + ': '); - case Angle of - ra0 : begin - Phone3Rect.Left := Phone3Rect.Left + PhoneLblWidth; - Phone3Rect.Top := Phone3Rect.Top + (TextMargin div 2); - end; - ra90 : begin - Phone3Rect.Top := Phone3Rect.Top + PhoneLblWidth; - Phone3Rect.Left := Phone3Rect.Left + (TextMargin); - end; - ra180 : begin - Phone3Rect.Left := Phone3Rect.Left - PhoneLblWidth; - Phone3Rect.Top := Phone3Rect.Top + (TextMargin div 2); - end; - ra270 : begin - Phone3Rect.Top := Phone3Rect.Top - PhoneLblWidth; - Phone3Rect.Left := Phone3Rect.Left + (TextMargin div 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone3Rect.Left, - Phone3Rect.Top, Str); - end; - - { do Phone4 } - Str := TmpCon.Phone4; - if Str <> '' then begin - case Angle of - ra0 : begin - Phone4Rect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - Phone4Rect.BottomRight := Point(TmpBmp.Width, Phone4Rect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := Phone4Rect.Bottom; - end; - ra90 : begin - Phone4Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - Phone4Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := Phone4Rect.Left; - end; - ra180 : begin - Phone4Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - Phone4Rect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := Phone4Rect.Top; - end; - ra270 : begin - Phone4Rect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - Phone4Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := Phone4Rect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone4Rect.Left + TextMargin, - Phone4Rect.Top + (TextMargin div 2), - PhoneLabel(TVpPhoneType(TmpCon.PhoneType4)) + ': '); - case Angle of - ra0 : begin - Phone4Rect.Left := Phone4Rect.Left + PhoneLblWidth; - Phone4Rect.Top := Phone4Rect.Top + (TextMargin div 2); - end; - ra90 : begin - Phone4Rect.Top := Phone4Rect.Top + PhoneLblWidth; - Phone4Rect.Left := Phone4Rect.Left + (TextMargin {div 2}); - end; - ra180 : begin - Phone4Rect.Left := Phone4Rect.Left - PhoneLblWidth; - Phone4Rect.Top := Phone4Rect.Top + (TextMargin div 2); - end; - ra270 : begin - Phone4Rect.Top := Phone4Rect.Top - PhoneLblWidth; - Phone4Rect.Left := Phone4Rect.Left + (TextMargin div 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone4Rect.Left, - Phone4Rect.Top, Str); - end; - - { do Phone5 } - Str := TmpCon.Phone5; - if Str <> '' then begin - case Angle of - ra0 : begin - Phone5Rect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - Phone5Rect.BottomRight := Point(TmpBmp.Width, Phone5Rect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := Phone5Rect.Bottom; - end; - ra90 : begin - Phone5Rect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - Phone5Rect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := Phone5Rect.Left; - end; - ra180 : begin - Phone5Rect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - Phone5Rect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := Phone5Rect.Top; - end; - ra270 : begin - Phone5Rect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - Phone5Rect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := Phone5Rect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone5Rect.Left + TextMargin, - Phone5Rect.Top + (TextMargin div 2), - PhoneLabel(TVpPhoneType(TmpCon.PhoneType5)) + ': '); - case Angle of - ra0 : begin - Phone5Rect.Left := Phone5Rect.Left + PhoneLblWidth; - Phone5Rect.Top := Phone5Rect.Top + (TextMargin div 2); - end; - ra90 : begin - Phone5Rect.Top := Phone5Rect.Top+ PhoneLblWidth; - Phone5Rect.Left := Phone5Rect.Left + (TextMargin); - end; - ra180 : begin - Phone5Rect.Left := Phone5Rect.Left - PhoneLblWidth; - Phone5Rect.Top := Phone5Rect.Top + (TextMargin div 2); - end; - ra270 : begin - Phone5Rect.Top := Phone5Rect.Top - PhoneLblWidth; - Phone5Rect.Left := Phone5Rect.Left + (TextMargin div 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - Phone5Rect.Left, - Phone5Rect.Top, Str); - end; - - { do EMail } - Str := TmpCon.EMail; - if Str <> '' then begin - case Angle of - ra0 : begin - EMailRect.TopLeft := Point(TextMargin, WholeRect.Bottom - + (TextMargin div 2)); - EMailRect.BottomRight := Point(TmpBmp.Width, EMailRect.Top + - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2)); - WholeRect.Bottom := EMailRect.Bottom; - end; - ra90 : begin - EMailRect.TopLeft := Point (WholeRect.Left - TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - TextMargin); - EMailRect.BottomRight := Point (WholeRect.Left - (TextMargin div 2), - WholeRect.Bottom + (TextMargin div 2)); - WholeRect.Left := EMailRect.Left; - end; - ra180 : begin - EMailRect.TopLeft := Point (WholeRect.Right - TextMargin * 2, - WholeRect.Top - TmpBmp.Canvas.TextHeight(VpProductName) - TextMargin); - EMailRect.BottomRight := Point (WholeRect.Left + TextMargin, - WholeRect.Top - (TextMargin div 2)); - WholeRect.Top := EMailRect.Top; - end; - ra270 : begin - EMailRect.TopLeft := Point (WholeRect.Right, - WholeRect.Bottom - TextMargin); - EMailRect.BottomRight := Point (WholeRect.Right + TmpBmp.Canvas.TextHeight(VpProductName) + (TextMargin div 2), - WholeRect.Top + (TextMargin div 2)); - WholeRect.Right := EMailRect.Right; - end; - end; - Str := GetDisplayString(TmpBmp.Canvas, Str, 2, TextColWidth - - (TextMargin * 2) - PhoneLblWidth); - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - EMailRect.Left + TextMargin, - EMailRect.Top + (TextMargin div 2), RSEmail + ': '); - case Angle of - ra0 : begin - EMailRect.Left := EMailRect.Left + PhoneLblWidth; - EmailRect.Top := EMailRect.Top + (TextMargin div 2); - end; - ra90 : begin - EMailRect.Top := EMailRect.Top + PhoneLblWidth; - EmailRect.Left := EMailRect.Left + TextMargin; - end; - ra180 : begin - EMailRect.Left := EMailRect.Left - PhoneLblWidth; - EmailRect.Top := EMailRect.Top + (TextMargin div 2); - end; - ra270 : begin - EMailRect.Top := EMailRect.Top - PhoneLblWidth; - EMailRect.Left := EMailRect.Left + (TextMargin div 2); - end; - end; - TPSTextOutAtPoint (TmpBmp.Canvas, Angle, TmpBmpRect, - EMailRect.Left, - EMailRect.Top, Str); - end; - - { if this record's too big to fit in the remaining area of this } - { column, then slide over to the top of the next column } - case Angle of - ra0 : begin - if (RenderIn.Top + Anchor.y + WholeRect.Bottom >= RenderIn.Bottom - TextMargin * 3) and - (RecsInCol > 0) - then begin - Anchor := Point( - Anchor.x + WholeRect.Right + FBarWidth + 1 + TextMargin * 3, - 2 + TextMargin * 2 - ); - if Col = 1 then - cgCol1RecCount := RecsInCol; - Inc(Col); - RecsInCol := 0; - if DisplayOnly and (Anchor.X + TextColWidth >= RenderIn.Right) then - Exit; - end; - end; - ra90 : begin - if (Anchor.x + RenderIn.Left + WholeRect.Right - WholeRect.Left > RenderIn.Right - TextMargin * 3) and - (RecsInCol > 0) - then begin - Anchor.x := 2 + TextMargin * 2; - Anchor.y := Anchor.y + WholeRect.Bottom + FBarWidth + 1 + TextMargin * 3; - if Col = 1 then - cgCol1RecCount := RecsInCol; - Inc(Col); - RecsInCol := 0; - if DisplayOnly and (Anchor.y + TextColWidth >= RenderIn.Bottom) then - Exit; - end; - end; - ra180 : begin - if (Anchor.y + RenderIn.Top - WholeRect.Bottom - WholeRect.Top <= RenderIn.Top + TextMargin * 3) and - (RecsInCol > 0) then - begin - Anchor.x := Anchor.x - (WholeRect.Right + FBarWidth + 1 + TextMargin * 3); - Anchor.y := TmpBmp.Height - 2 - TextMargin * 2; - if Col = 1 then - cgCol1RecCount := RecsInCol; - Inc(Col); - RecsInCol := 0; - if DisplayOnly and (Anchor.x + TextColWidth < RenderIn.Left) then - Exit; - end; - end; - ra270 : begin - if (Anchor.x + RenderIn.Left + (WholeRect.Right - WholeRect.Left) >= RenderIn.Right - TextMargin * 3) and - (RecsInCol > 0) then - begin - Anchor.x := 2 + TextMargin * 2; - Anchor.y := Anchor.y - (WholeRect.Bottom + FBarWidth + 1 + TextMargin * 3); - if Col = 1 then - cgCol1RecCount := RecsInCol; - Inc(Col); - RecsInCol := 0; - if DisplayOnly and (Anchor.y + TextColWidth <= RenderIn.Top) then - Exit; - end; - end; - end; - - { add a little spacing between records } - case Angle of - ra0 : WholeRect.Bottom := WholeRect.Bottom + TextMargin * 2; - ra90 : WholeRect.Left := WholeRect.Left - TextMargin * 2; - ra180 : WholeRect.Top := WholeRect.Top - TextMargin * 2; - ra270 : WholeRect.Right := WholeRect.Right + TextMargin * 2; - end; - - { Update Array Rects } - cgContactArray[I].WholeRect.TopLeft := Point( - Anchor.X, Anchor.Y + WholeRect.Top); - cgContactArray[I].WholeRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + WholeRect.Bottom); - - cgContactArray[I].HeaderRect.TopLeft := Point( - Anchor.X, Anchor.Y + HeadRect.Top); - cgContactArray[I].HeaderRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + HeadRect.Bottom); - - cgContactArray[I].AddressRect.TopLeft := Point( - Anchor.X, Anchor.Y + AddrRect.Top); - cgContactArray[I].AddressRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + AddrRect.Bottom); - - cgContactArray[I].CSZRect.TopLeft := Point( - Anchor.X, Anchor.Y + CSZRect.Top); - cgContactArray[I].CSZRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + CSZRect.Bottom); - - cgContactArray[I].CompanyRect.TopLeft := Point( - Anchor.X, Anchor.Y + CompanyRect.Top); - cgContactArray[I].CompanyRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + CompanyRect.Bottom); - - cgContactArray[I].EMailRect.TopLeft := Point( - Anchor.X + EMailRect.Left, Anchor.Y + EMailRect.Top); - cgContactArray[I].EMailRect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + EMailRect.Bottom); - - cgContactArray[I].Phone1Rect.TopLeft := Point( - Anchor.X + Phone1Rect.Left, Anchor.Y + Phone1Rect.Top); - cgContactArray[I].Phone1Rect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + Phone1Rect.Bottom); - - cgContactArray[I].Phone2Rect.TopLeft := Point( - Anchor.X + Phone2Rect.Left, Anchor.Y + Phone2Rect.Top); - cgContactArray[I].Phone2Rect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + Phone2Rect.Bottom); - - cgContactArray[I].Phone3Rect.TopLeft := Point( - Anchor.X + Phone3Rect.Left, Anchor.Y + Phone3Rect.Top); - cgContactArray[I].Phone3Rect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + Phone3Rect.Bottom); - - cgContactArray[I].Phone4Rect.TopLeft := Point( - Anchor.X + Phone4Rect.Left, Anchor.Y + Phone4Rect.Top); - cgContactArray[I].Phone4Rect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + Phone4Rect.Bottom); - - cgContactArray[I].Phone5Rect.TopLeft := Point( - Anchor.X + Phone5Rect.Left, Anchor.Y + Phone5Rect.Top); - cgContactArray[I].Phone5Rect.BottomRight := Point( - Anchor.X + TmpBmp.Width, Anchor.Y + Phone5Rect.Bottom); - - { move the drawn record from the bitmap to the component canvas } - - case Angle of - ra0 : - RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left, - Anchor.Y + WholeRect.Top + RenderIn.Top, - Anchor.X + TmpBmp.Width + RenderIn.Left, - Anchor.Y + WholeRect.Bottom + RenderIn.Top), - TmpBmp.Canvas, WholeRect); - ra90 : - RenderCanvas.CopyRect (Rect (WholeRect.Left + RenderIn.Left - Anchor.X, - Anchor.Y + WholeRect.Top + RenderIn.Top, - WholeRect.Right + RenderIn.Left - Anchor.X, - Anchor.Y + WholeRect.Bottom + RenderIn.Top), - TmpBmp.Canvas, - Rect (WholeRect.Left, - WholeRect.Top, - WholeRect.Right, - WholeRect.Bottom)); - - ra180 : - RenderCanvas.CopyRect (Rect (Anchor.X + WholeRect.Left + RenderIn.Left, - Anchor.Y - (WholeRect.Bottom - WholeRect.Top) + RenderIn.Top, - Anchor.X + TmpBmp.Width + RenderIn.Left, - Anchor.Y + RenderIn.Top), - TmpBmp.Canvas, WholeRect); - - ra270 : - RenderCanvas.CopyRect (Rect (Anchor.X + RenderIn.Left, - Anchor.Y + RenderIn.Top, - Anchor.X + RenderIn.Left + (WholeRect.Right - WholeRect.Left), - Anchor.Y + RenderIn.Top + (WholeRect.Bottom - WholeRect.Top)), - TmpBmp.Canvas, WholeRect); - end; - - { draw focusrect around selected record } - if Focused and (TmpCon = FActiveContact) then begin - with cgContactArray[I] do - RenderCanvas.DrawFocusRect(Rect(WholeRect.Left, WholeRect.Top - 3, - WholeRect.Right + TextMargin, WholeRect.Bottom - 2)); - end; - - { slide anchor down for the next record } - case Angle of - ra0 : Anchor.Y := Anchor.Y + WholeRect.Bottom; - ra90 : Anchor.X := Anchor.X + (WholeRect.Right - WholeRect.Left); - ra180 : Anchor.Y := Anchor.Y - (WholeRect.Bottom - WholeRect.Top); - ra270 : Anchor.X := Anchor.X + WholeRect.Right; - end; - Inc(RecsInCol); - end; - end; - - if not DisplayOnly then - case Angle of - ra0 : begin - if (Anchor.X > RenderIn.Right) and - (I < DataStore.Resource.Contacts.Count) then begin - { we have filled in the visible area } - FContactsAfter := DataStore.Resource.Contacts.Count - I; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter; - Break; - end else begin - FContactsAfter := 0; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact; - end; - end; - ra90 : begin - if (Anchor.Y > RenderIn.Bottom) and - (I < DataStore.Resource.Contacts.Count) then begin - { we have filled in the visible area } - FContactsAfter := DataStore.Resource.Contacts.Count - I; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - FContactsAfter; - Break; - end else begin - FContactsAfter := 0; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact; - end; - end; - ra180 : begin - if (Anchor.X < RenderIn.Left) - and (I < DataStore.Resource.Contacts.Count) then begin - { we have filled in the visible area } - FContactsAfter := DataStore.Resource.Contacts.Count - I; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - - FContactsAfter; - Break; - end - else - FContactsAfter := 0; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact; - end; - ra270 : begin - if (Anchor.Y < RenderIn.Top) - and (I < DataStore.Resource.Contacts.Count) then begin - { we have filled in the visible area } - FContactsAfter := DataStore.Resource.Contacts.Count - I; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact - - FContactsAfter; - Break; - end - else - FContactsAfter := 0; - FVisibleContacts := DataStore.Resource.Contacts.Count - StartContact; - end; - end; - end; - finally - TmpBmp.Free; - end; - if FContactsAfter = 0 then - FLastPrintLine := -2 - else - FLastPrintLine := FContactsAfter; - - if (oldCol1RecCount > 0) and (cgCol1RecCount = 0) then - cgCol1RecCount := oldCol1RecCount; - end; - {--} - - procedure DrawBorders; - begin - if FDrawingStyle = dsFlat then begin - { draw an outer and inner bevel } - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left, - RenderIn.Top, - RenderIn.Right - 1, - RenderIn.Bottom - 1), - BevelShadow, - BevelHighlight); - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left + 1, - RenderIn.Top + 1, - RenderIn.Right - 2, - RenderIn.Bottom - 2), - BevelHighlight, - BevelShadow); - end else if FDrawingStyle = ds3d then begin - { draw a 3d bevel } - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left, - RenderIn.Top, - RenderIn.Right - 1, - RenderIn.Bottom - 1), - BevelShadow, - BevelHighlight); - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left + 1, - RenderIn.Top + 1, - RenderIn.Right - 2, - RenderIn.Bottom - 2), - BevelDarkShadow, - BevelFace); - end; - end; - {--} - -begin - if DisplayOnly then begin - RealColor := clWhite; - SizingBarColor := clBlack; - BevelDarkShadow := clBlack; - BevelShadow := clBlack; - BevelHighlight := clBlack; - BevelFace := clBlack; - RealBarColor := clBlack; - RealContactHeadAttrColor := clSilver; - end else begin - RealColor := Color; - SizingBarColor := clBlack; - BevelDarkShadow := cl3dDkShadow; - BevelShadow := clBtnShadow; - BevelHighlight := clBtnHighlight; - BevelFace := clBtnFace; - RealBarColor := BarColor; - RealContactHeadAttrColor := FContactHeadAttr.Color; - end; - - cgPainting := true; - SavePenStyle := RenderCanvas.Pen.Style; - SaveBrushColor := RenderCanvas.Brush.Color; - SavePenColor := RenderCanvas.Pen.Color; - - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Width := 1; - RenderCanvas.Pen.Mode := pmCopy; - RenderCanvas.Brush.Style := bsSolid; - - Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, - RenderIn.Right, RenderIn.Bottom); - try - SelectClipRgn (RenderCanvas.Handle, Rgn); - - if StartLine = -1 then - StartContact := FContactsBefore - else - StartContact := StartLine; - - SetMeasurements; - - if DisplayOnly and (PrintNumColumns > 0) then - RealColumnWidth := (RealWidth - ((2 + ExtraBarWidth) * (PrintNumColumns - 1))) div PrintNumColumns - else - RealColumnWidth := ColumnWidth; - - { clear the control } - Clear; - - { draw the contacts } - if StartLine <> -2 then - DrawContacts; - - { draw the vertical bars } - DrawVerticalBars; - - { draw the borders } - DrawBorders; - - SetHScrollPos; - - finally - SelectClipRgn (RenderCanvas.Handle, 0); - DeleteObject (Rgn); - end; - - { reinstate canvas settings } - RenderCanvas.Pen.Style := SavePenStyle; - RenderCanvas.Brush.Color := SaveBrushColor; - RenderCanvas.Pen.Color := SavePenColor; - cgPainting := false; -end; -{=====} -*) - { Introduced to support the buttonbar component !!.02} function TVpContactGrid.SelectContactByName(const Name: String): Boolean; var diff --git a/components/tvplanit/source/vptasklist.pas b/components/tvplanit/source/vptasklist.pas index 8b8a20d2b..9a228d310 100644 --- a/components/tvplanit/source/vptasklist.pas +++ b/components/tvplanit/source/vptasklist.pas @@ -43,8 +43,8 @@ uses type TVpTaskRec = packed record - Task : Pointer; - LineRect : TRect; + Task: Pointer; + LineRect: TRect; CheckRect: TRect; end; @@ -56,17 +56,17 @@ type TVpTaskDisplayOptions = class(TPersistent) protected{private} - FTaskList : TVpTaskList; - FShowAll : Boolean; - FShowCompleted : Boolean; - FShowDueDate : Boolean; - FDueDateFormat : string; - FCheckColor : TColor; - FCheckBGColor : TColor; - FCheckStyle : TVpCheckStyle; - FOverdueColor : TColor; - FNormalColor : TColor; - FCompletedColor : TColor; + FTaskList: TVpTaskList; + FShowAll: Boolean; + FShowCompleted: Boolean; + FShowDueDate: Boolean; + FDueDateFormat: string; + FCheckColor: TColor; + FCheckBGColor: TColor; + FCheckStyle: TVpCheckStyle; + FOverdueColor: TColor; + FNormalColor: TColor; + FCompletedColor: TColor; procedure SetCheckColor(Value: TColor); procedure SetCheckBGColor(Value: TColor); procedure SetCheckStyle(Value: TVpCheckStyle); @@ -78,29 +78,19 @@ type procedure SetNormalColor(Value: TColor); procedure SetCompletedColor(Value: TColor); public - constructor Create(Owner : TVpTaskList); + constructor Create(Owner: TVpTaskList); destructor Destroy; override; published - property CheckBGColor: TColor - read FCheckBGColor write SetCheckBGColor; - property CheckColor: TColor - read FCheckColor write SetCheckColor; - property CheckStyle: TVpCheckStyle - read FCheckStyle write SetCheckStyle; - property DueDateFormat: string - read FDueDateFormat write SetDueDateFormat; - property ShowCompletedTasks : Boolean - read FShowCompleted write SetShowCompleted; - property ShowAll : Boolean - read FShowAll write SetShowAll; - property ShowDueDate: Boolean - read FShowDueDate write SetShowDueDate; - property OverdueColor : TColor - read FOverdueColor write SetOverdueColor; - property NormalColor : TColor - read FNormalColor write SetNormalColor; - property CompletedColor : TColor - read FCompletedColor write SetCompletedColor; + property CheckBGColor: TColor read FCheckBGColor write SetCheckBGColor; + property CheckColor: TColor read FCheckColor write SetCheckColor; + property CheckStyle: TVpCheckStyle read FCheckStyle write SetCheckStyle; + property DueDateFormat: string read FDueDateFormat write SetDueDateFormat; + property ShowCompletedTasks: Boolean read FShowCompleted write SetShowCompleted; + property ShowAll: Boolean read FShowAll write SetShowAll; + property ShowDueDate: Boolean read FShowDueDate write SetShowDueDate; + property OverdueColor: TColor read FOverdueColor write SetOverdueColor; + property NormalColor: TColor read FNormalColor write SetNormalColor; + property CompletedColor: TColor read FCompletedColor write SetCompletedColor; end; { InPlace Editor } @@ -118,8 +108,8 @@ type FTaskList: TVpTaskList; FFont: TFont; FColor: TColor; - procedure SetColor (Value: TColor); - procedure SetFont (Value: TFont); + procedure SetColor(Value: TColor); + procedure SetFont(Value: TFont); public constructor Create(AOwner: TVpTaskList); destructor Destroy; override; @@ -127,50 +117,48 @@ type { The Invalidate method is used as a bridge between FFont & FTaskList. } property TaskList: TVpTaskList read FTaskList; published - property Color: TColor - read FColor write SetColor; - property Font: TFont - read FFont write SetFont; + property Color: TColor read FColor write SetColor; + property Font: TFont read FFont write SetFont; end; { Task List } TVpTaskList = class(TVpLinkableControl) protected{ private } - FColor : TColor; - FCaption : string; - FDisplayOptions : TVpTaskDisplayOptions; - FLineColor : TColor; - FActiveTask : TVpTask; - FShowResourceName : Boolean; - FTaskIndex : Integer; - FScrollBars : TScrollStyle; - FTaskHeadAttr : TVpTaskHeadAttr; - FMaxVisibleTasks : Word; - FDrawingStyle : TVpDrawingStyle; - FTaskID : Integer; - FDefaultPopup : TPopupMenu; - FShowIcon : Boolean; - FAllowInplaceEdit : Boolean; + FColor: TColor; + FCaption: string; + FDisplayOptions: TVpTaskDisplayOptions; + FLineColor: TColor; + FActiveTask: TVpTask; + FShowResourceName: Boolean; + FTaskIndex: Integer; + FScrollBars: TScrollStyle; + FTaskHeadAttr: TVpTaskHeadAttr; + FMaxVisibleTasks: Word; + FDrawingStyle: TVpDrawingStyle; + FTaskID: Integer; + FDefaultPopup: TPopupMenu; + FShowIcon: Boolean; + FAllowInplaceEdit: Boolean; { task variables } - FOwnerDrawTask : TVpOwnerDrawTask; - FBeforeEdit : TVpBeforeEditTask; - FAfterEdit : TVpAfterEditTask; - FOwnerEditTask : TVpEditTask; + FOwnerDrawTask: TVpOwnerDrawTask; + FBeforeEdit: TVpBeforeEditTask; + FAfterEdit: TVpAfterEditTask; + FOwnerEditTask: TVpEditTask; { internal variables } - tlVisibleTaskArray : TVpTaskArray; - tlAllTaskList : TList; - tlItemsBefore : Integer; - tlItemsAfter : Integer; - tlVisibleItems : Integer; - tlHitPoint : TPoint; - tlClickTimer : TTimer; - tlLoaded : Boolean; - tlRowHeight : Integer; - tlInPlaceEditor : TVpTLInPlaceEdit; - tlCreatingEditor : Boolean; - tlPainting : Boolean; - tlVScrollDelta : Integer; - tlHotPoint : TPoint; + tlVisibleTaskArray: TVpTaskArray; + tlAllTaskList: TList; + tlItemsBefore: Integer; + tlItemsAfter: Integer; + tlVisibleItems: Integer; + tlHitPoint: TPoint; + tlClickTimer: TTimer; + tlLoaded: Boolean; + tlRowHeight: Integer; + tlInPlaceEditor: TVpTLInPlaceEdit; + tlCreatingEditor: Boolean; + tlPainting: Boolean; + tlVScrollDelta: Integer; + tlHotPoint: TPoint; { property methods } function GetTaskIndex: Integer; @@ -179,13 +167,13 @@ type procedure SetTaskIndex(Value: Integer); procedure SetDrawingStyle(const Value: TVpDrawingStyle); procedure SetColor(const Value: TColor); reintroduce; - procedure SetShowIcon (const v : Boolean); + procedure SetShowIcon(const v: Boolean); procedure SetShowResourceName(Value: Boolean); { internal methods } procedure InitializeDefaultPopup; - procedure PopupAddTask (Sender : TObject); - procedure PopupDeleteTask (Sender : TObject); - procedure PopupEditTask (Sender : TObject); + procedure PopupAddTask(Sender: TObject); + procedure PopupDeleteTask(Sender: TObject); + procedure PopupEditTask(Sender: TObject); procedure tlSetVScrollPos; procedure tlCalcRowHeight; procedure tlEditInPlace(Sender: TObject); @@ -194,18 +182,18 @@ type procedure Loaded; override; procedure tlSpawnTaskEditDialog(NewTask: Boolean); procedure tlSetActiveTaskByCoord(Pnt: TPoint); - function tlVisibleTaskToTaskIndex (const VisTaskIndex : Integer) : Integer; - function tlTaskIndexToVisibleTask (const ATaskIndex : Integer) : Integer; + function tlVisibleTaskToTaskIndex(const VisTaskIndex: Integer) : Integer; + function tlTaskIndexToVisibleTask(const ATaskIndex: Integer) : Integer; procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; {$IFNDEF LCL} - procedure WMLButtonDown(var Msg : TWMLButtonDown); message WM_LBUTTONDOWN; - procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk); message WM_LBUTTONDBLCLK; - procedure WMRButtonDown (var Msg : TWMRButtonDown); message WM_RBUTTONDOWN; + procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; + procedure WMRButtonDown (var Msg: TWMRButtonDown); message WM_RBUTTONDOWN; {$ELSE} - procedure WMLButtonDown(var Msg : TLMLButtonDown); message LM_LBUTTONDOWN; - procedure WMLButtonDblClk(var Msg : TLMLButtonDblClk); message LM_LBUTTONDBLCLK; - procedure WMRButtonDown (var Msg : TLMRButtonDown); message LM_RBUTTONDOWN; + procedure WMLButtonDown(var Msg: TLMLButtonDown); message LM_LBUTTONDOWN; + procedure WMLButtonDblClk(var Msg: TLMLButtonDblClk); message LM_LBUTTONDBLCLK; + procedure WMRButtonDown (var Msg: TLMRButtonDown); message LM_RBUTTONDOWN; {$ENDIF} procedure EditTask; procedure EndEdit(Sender: TObject); @@ -225,17 +213,17 @@ type destructor Destroy; override; procedure DeleteActiveTask(Verify: Boolean); procedure LoadLanguage; - procedure LinkHandler(Sender: TComponent; - NotificationType: TVpNotificationType; + procedure LinkHandler(Sender: TComponent; NotificationType: TVpNotificationType; const Value: Variant); override; function GetControlType: TVpItemType; override; - procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; - Angle: TVpRotationAngle); + procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; Angle: TVpRotationAngle); procedure RenderToCanvas(RenderCanvas: TCanvas; RenderIn: TRect; Angle: TVpRotationAngle; Scale: Extended; RenderDate: TDateTime; StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override; + property ActiveTask: TVpTask read FActiveTask; property TaskIndex: Integer read GetTaskIndex write SetTaskIndex; + published {inherited properties} property Align; @@ -247,29 +235,18 @@ type property AllowInplaceEditing: Boolean read FAllowInplaceEdit write FAllowInplaceEdit default true; - property DisplayOptions: TVpTaskDisplayOptions - read FDisplayOptions write FDisplayOptions; - property LineColor: TColor - read FLineColor write SetLineColor; - property MaxVisibleTasks: Word - read FMaxVisibleTasks write SetMaxVisibleTasks; - property TaskHeadAttributes: TVpTaskHeadAttr - read FTaskHeadAttr write FTaskHeadAttr; - property DrawingStyle: TVpDrawingStyle - read FDrawingStyle write SetDrawingStyle; - property Color: TColor - read FColor write SetColor; - property ShowIcon : Boolean - read FShowIcon write SetShowIcon default True; - property ShowResourceName: Boolean - read FShowResourceName write SetShowResourceName; + property DisplayOptions: TVpTaskDisplayOptions read FDisplayOptions write FDisplayOptions; + property LineColor: TColor read FLineColor write SetLineColor; + property MaxVisibleTasks: Word read FMaxVisibleTasks write SetMaxVisibleTasks; + property TaskHeadAttributes: TVpTaskHeadAttr read FTaskHeadAttr write FTaskHeadAttr; + property DrawingStyle: TVpDrawingStyle read FDrawingStyle write SetDrawingStyle; + property Color: TColor read FColor write SetColor; + property ShowIcon: Boolean read FShowIcon write SetShowIcon default True; + property ShowResourceName: Boolean read FShowResourceName write SetShowResourceName; { events } - property BeforeEdit: TVpBeforeEditTask - read FBeforeEdit write FBeforeEdit; - property AfterEdit : TVpAfterEditTask - read FAfterEdit write FAfterEdit; - property OnOwnerEditTask: TVpEditTask - read FOwnerEditTask write FOwnerEditTask; + property BeforeEdit: TVpBeforeEditTask read FBeforeEdit write FBeforeEdit; + property AfterEdit: TVpAfterEditTask read FAfterEdit write FAfterEdit; + property OnOwnerEditTask: TVpEditTask read FOwnerEditTask write FOwnerEditTask; end; implementation @@ -286,7 +263,7 @@ constructor TVpTaskDisplayOptions.Create(Owner: TVpTaskList); begin inherited Create; FTaskList := Owner; - FDueDateFormat := DefaultFormatSettings.ShortDateFormat; + FDueDateFormat := DefaultFormatSettings.ShortDateFormat; FShowDueDate := true; FCheckColor := cl3DDkShadow; FCheckBGColor := clWindow; @@ -469,30 +446,34 @@ end; procedure TVpTLInPlaceEdit.KeyDown(var Key: Word; Shift: TShiftState); var - TaskList : TVpTaskList; + TaskList: TVpTaskList; begin TaskList := TVpTaskList(Owner); case Key of - VK_RETURN: begin - Key := 0; - TaskList.EndEdit(Self); - end; + VK_RETURN: + begin + Key := 0; + TaskList.EndEdit(Self); + end; - VK_UP: begin - Key := 0; - TaskList.TaskIndex := TaskList.TaskIndex - 1; - end; + VK_UP: + begin + Key := 0; + TaskList.TaskIndex := TaskList.TaskIndex - 1; + end; - VK_DOWN: begin - Key := 0; - TaskList.TaskIndex := TaskList.TaskIndex + 1; - end; + VK_DOWN: + begin + Key := 0; + TaskList.TaskIndex := TaskList.TaskIndex + 1; + end; - VK_ESCAPE: begin - Key := 0; - TaskList.EndEdit(Self); - end; + VK_ESCAPE: + begin + Key := 0; + TaskList.EndEdit(Self); + end; else inherited; @@ -517,31 +498,31 @@ begin {$IFDEF VERSION4} DoubleBuffered := true; {$ENDIF} - tlItemsBefore := 0; - tlItemsAfter := 0; - tlVisibleItems := 0; - tlClickTimer.Enabled := false; - FMaxVisibleTasks := 250; + tlItemsBefore := 0; + tlItemsAfter := 0; + tlVisibleItems := 0; + tlClickTimer.Enabled := false; + FMaxVisibleTasks := 250; tlClickTimer.Interval := ClickDelay; - tlClickTimer.OnTimer := tlEditInPlace; - tlCreatingEditor := false; - FDrawingStyle := ds3d; - tlPainting := false; - FShowResourceName := true; - FColor := clWindow; - FLineColor := clGray; - FScrollBars := ssVertical; - FTaskIndex := -1; - FShowIcon := True; - FAllowInplaceEdit := true; + tlClickTimer.OnTimer := tlEditInPlace; + tlCreatingEditor := false; + FDrawingStyle := ds3d; + tlPainting := false; + FShowResourceName := true; + FColor := clWindow; + FLineColor := clGray; + FScrollBars := ssVertical; + FTaskIndex := -1; + FShowIcon := True; + FAllowInplaceEdit := true; SetLength(tlVisibleTaskArray, MaxVisibleTasks); { size } Height := 225; - Width := 169; + Width := 169; - FDefaultPopup := TPopupMenu.Create (Self); + FDefaultPopup := TPopupMenu.Create(Self); InitializeDefaultPopup; tlHookUp; @@ -573,8 +554,8 @@ begin if DoIt then begin FActiveTask.Deleted := true; - if Assigned (DataStore) then - if Assigned (DataStore.Resource) then + if Assigned(DataStore) then + if Assigned(DataStore.Resource) then DataStore.Resource.TasksDirty := True; DataStore.PostTasks; DataStore.RefreshTasks; @@ -624,7 +605,7 @@ begin end; {=====} -function TVpTaskList.GetControlType : TVpItemType; +function TVpTaskList.GetControlType: TVpItemType; begin Result := itTasks; end; @@ -633,25 +614,24 @@ end; procedure TVpTaskList.Paint; begin { paint simply calls RenderToCanvas and passes in the screen canvas. } - RenderToCanvas (Canvas, {Screen Canvas} - Rect (0, 0, Width, Height), { Clipping Rectangle } - ra0, { Rotation Angle } - 1, { Scale } - Now, { Render Date } - tlItemsBefore, { Starting Line } - -1, { Stop Line } - gr30Min, { Granularity - Not used int the task list } - False); { Display Only - True for a printed version, } - { False for an interactive version } + RenderToCanvas( + Canvas, { Screen Canvas} + Rect(0, 0, Width, Height), { Clipping Rectangle } + ra0, { Rotation Angle } + 1, { Scale } + Now, { Render Date } + tlItemsBefore, { Starting Line } + -1, { Stop Line } + gr30Min, { Granularity - Not used int the task list } + False { Display Only - True for a printed version, } + ); { False for an interactive version } end; {=====} -procedure TVpTaskList.PaintToCanvas (ACanvas : TCanvas; - ARect : TRect; - Angle : TVpRotationAngle); +procedure TVpTaskList.PaintToCanvas(ACanvas: TCanvas; ARect: TRect; + Angle: TVpRotationAngle); begin - RenderToCanvas (ACanvas, ARect, Angle, 1, Now, - -1, -1, gr30Min, True); + RenderToCanvas(ACanvas, ARect, Angle, 1, Now, -1, -1, gr30Min, True); end; {=====} @@ -671,520 +651,6 @@ begin tlPainting := false; end; end; -(* -var - HeadRect : TRect; - Bmp : Graphics.TBitmap; - SaveBrushColor : TColor; - SavePenStyle : TPenStyle; - SavePenColor : TColor; - RowHeight : Integer; - - RealWidth : Integer; - RealHeight : Integer; - RealLeft : Integer; - RealRight : Integer; - RealTop : Integer; - RealBottom : Integer; - Rgn : HRGN; - - RealColor : TColor; - BackgroundSelHighlight : TColor; - ForegroundSelHighlight : TColor; - BevelShadow : TColor; - BevelHighlight : TColor; - BevelDarkShadow : TColor; - BevelFace : TColor; - RealLineColor : TColor; - RealCheckBgColor : TColor; - RealCheckBoxColor : TColor; - RealCheckColor : TColor; - RealCompleteColor : TColor; - RealOverdueColor : TColor; - RealNormalColor : TColor; - TaskHeadAttrColor : TColor; - - procedure DrawLines; - var - LinePos: Integer; - begin - RenderCanvas.Pen.Color := RealLineColor; - RenderCanvas.Pen.Style := psSolid; - LinePos := HeadRect.Bottom + RowHeight; - while LinePos < RealBottom do begin - TPSMoveTo (RenderCanvas, Angle, RenderIn, RealLeft, LinePos); - TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2, LinePos); - Inc (LinePos, RowHeight); - end; - end; - {-} - - procedure Clear; - var - I: Integer; - begin - RenderCanvas.Brush.Color := RealColor; - RenderCanvas.FillRect (RenderIn); - - { Clear the LineRect } - for I := 0 to pred(Length(tlVisibleTaskArray)) do begin - tlVisibleTaskArray[I].Task := nil; - tlVisibleTaskArray[I].LineRect := Rect(0, 0, 0, 0); - end; - end; - {-} - - procedure SetMeasurements; - begin - RealWidth := TPSViewportWidth (Angle, RenderIn); - RealHeight := TPSViewportHeight (Angle, RenderIn); - RealLeft := TPSViewportLeft (Angle, RenderIn); - RealRight := TPSViewportRight (Angle, RenderIn); - RealTop := TPSViewportTop (Angle, RenderIn); - RealBottom := TPSViewportBottom (Angle, RenderIn); - end; - - procedure MeasureRowHeight; - begin - RenderCanvas.Font.Assign(Font); - RowHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin * 2; - end; - {-} - - function DrawCheck (Rec : TRect; Checked : Boolean) : TRect; - { draws the check box and returns it's rectangle } - var - CR: TRect; { checbox rectangle } - W: Integer; { width of the checkbox } - X, Y: Integer; { Coordinates } - begin - X := Rec.Left + TextMargin; - Y := Rec.Top + TextMargin; - W := RowHeight - TextMargin * 2; - - { draw check box } - if FDrawingStyle = dsFlat then begin - RenderCanvas.Brush.Color := RealCheckBgColor; - RenderCanvas.Pen.Color := RealCheckBoxColor; - TPSRectangle (RenderCanvas, Angle, RenderIn, - Rect (X, Y, X + W, Y + W)); - end else - begin - // complete box, rather bright - RenderCanvas.Pen.Color := RGB (192, 204, 216); - RenderCanvas.Brush.Color := RealCheckBgColor; - TPSRectangle (RenderCanvas, Angle, RenderIn, - Rect (X, Y, X + W, Y + W)); - // left and top lines - RenderCanvas.Pen.Color := RGB (80, 100, 128); - TPSPolyLine (RenderCanvas, Angle, RenderIn, - [Point(X, Y + W - 2), Point(X, Y), Point(X + W - 1, Y)]); - // left and top lines - RenderCanvas.Pen.Color := RealCheckBoxColor; - TPSPolyLine (RenderCanvas, Angle, RenderIn, - [Point(X + 1, Y + W - 3), Point(X + 1, Y + 1), - Point(X + W - 2, Y + 1)]); - // right and bottom lines - RenderCanvas.Pen.Color := RGB(128, 152, 176); - TPSPolyLine (RenderCanvas, Angle, RenderIn, - [Point(X + 1, Y + W - 2), Point(X + W - 2, Y + W - 2), - Point(X+W-2, Y)]); - end; - - { build check rect } - CR := Rect(X + 3, Y + 3, X + W - 3, Y + W - 3); - if Checked then begin - RenderCanvas.Pen.Color := RealCheckColor; - case FDisplayOptions.CheckStyle of - csX : {X} - begin - with RenderCanvas do begin - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom); - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Top+1); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Bottom); - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Top); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Bottom-1); - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-1); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-2); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right-1, CR.Top-1); - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+1, CR.Bottom-1); - TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); - end; - end; - csCheck : {check} - begin - with RenderCanvas do begin - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, - CR.Bottom - ((CR.Bottom - cr.Top) div 4)); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Left + ((CR.Right - CR.Left) div 4), - CR.Bottom); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Right, CR.Top + 2); - - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, - CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 1); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Left + ((CR.Right - CR.Left) div 4), - CR.Bottom - 1); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Right, CR.Top + 1); - - TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, - CR.Bottom - ((CR.Bottom - cr.Top) div 4) - 2); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Left + ((CR.Right - CR.Left) div 4), - CR.Bottom - 2); - TPSLineTo (RenderCanvas, Angle, RenderIn, - CR.Right, CR.Top); - - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-5); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-2); } - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-4); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom-1); } - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left, CR.Bottom-3); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Left+3, CR.Bottom); } - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-3); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top-1); } - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-2); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top); } - {TPSMoveTo (RenderCanvas, Angle, RenderIn, CR.Left+2, CR.Bottom-1); } - {TPSLineTo (RenderCanvas, Angle, RenderIn, CR.Right, CR.Top+1); } - end; - end; - end; - end; {if checked} - result := cr; - end; - - procedure DrawTasks; - var - I : Integer; - Task : TVpTask; - LineRect : TRect; - CheckRect : TRect; - DisplayStr : string; - begin - if (DataStore = nil) or - (DataStore.Resource = nil) or - (DataStore.Resource.Tasks.Count = 0) then begin - if Focused then begin - LineRect.TopLeft := Point (RealLeft + 2, - HeadRect.Bottom); - LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4, - LineRect.Top + RowHeight); - RenderCanvas.Brush.Color := BackgroundSelHighlight; - RenderCanvas.FillRect(LineRect); - RenderCanvas.Brush.Color := RealColor; - end; - Exit; - end; - - LineRect.TopLeft := Point (RealLeft + 2, - HeadRect.Bottom); - LineRect.BottomRight := Point (LineRect.Left + RealWidth - 4, - LineRect.Top + RowHeight); - - tlVisibleItems := 0; - RenderCanvas.Brush.Color := RealColor; - - tlAllTaskList.Clear; - - { Make sure the tasks are properly sorted } - DataStore.Resource.Tasks.Sort; - - for I := 0 to pred(DataStore.Resource.Tasks.Count) do begin - if DisplayOptions.ShowAll then - { Get all tasks regardless of their status and due date } - tlAllTaskList.Add(DataStore.Resource.Tasks.GetTask(I)) - else begin - { get all tasks which are incomplete, or were just completed today.} - Task := DataStore.Resource.Tasks.GetTask(I); - if not Task.Complete then - tlAllTaskList.Add(Task) - else if FDisplayOptions.ShowCompletedTasks - and (trunc(Task.CompletedOn) = trunc(now)) then - tlAllTaskList.Add(Task); - end; - end; - - RenderCanvas.Font.Assign(Font); - for I := StartLine to pred(tlAllTaskList.Count) do begin - Task := tlAllTaskList[I]; - if (LineRect.Top + Trunc(RowHeight * 0.5) <= RealBottom) then begin - { if this is the selected task and we are not in edit mode, } - { then set background selection } - if (Task = FActiveTask) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) - and (not DisplayOnly) and Focused then begin - RenderCanvas.Brush.Color := BackgroundSelHighlight; - RenderCanvas.FillRect(LineRect); - RenderCanvas.Brush.Color := RealColor; - end; - - { draw the checkbox } - CheckRect := DrawCheck (LineRect, Task.Complete); - - if Task.Complete then begin - { complete task } - RenderCanvas.Font.Style := RenderCanvas.Font.Style + [fsStrikeout]; - RenderCanvas.Font.Color := RealCompleteColor; - end else begin - { incomplete task } - RenderCanvas.Font.Style := RenderCanvas.Font.Style - [fsStrikeout]; - if (Trunc (Task.DueDate) < Trunc (Now)) and - (Trunc (Task.DueDate) <> 0) then - { overdue task } - RenderCanvas.Font.Color := RealOverdueColor - else - RenderCanvas.Font.Color := RealNormalColor; - end; - - { if this is the selected task, set highlight text color } - if (Task = FActiveTask) and ((tlInPlaceEditor = nil) or not tlInplaceEditor.Visible) - and (not DisplayOnly) and Focused then - RenderCanvas.Font.Color := ForegroundSelHighlight; - - { build display string } - DisplayStr := ''; - if (FDisplayOptions.ShowDueDate) and - (Trunc (Task.DueDate) <> 0) then - DisplayStr := FormatDateTime(FDisplayOptions.DueDateFormat, - Task.DueDate) + ' - '; - DisplayStr := DisplayStr + Task.description; - - { Adjust display string - If the string is too long for the available } - { space, Chop the end off and replace it with an ellipses. } - DisplayStr := GetDisplayString(RenderCanvas, DisplayStr, 3, - LineRect.Right - LineRect.Left - CheckRect.Right - TextMargin); - - { paint the text } - TPSTextOut(RenderCanvas, Angle, RenderIn, CheckRect.Right - + TextMargin * 2, LineRect.Top + TextMargin, DisplayStr); - - { store the tasks drawing details } - tlVisibleTaskArray[tlVisibleItems].Task := Task; - tlVisibleTaskArray[tlVisibleItems].LineRect := Rect(CheckRect.Right - + TextMargin, LineRect.Top, LineRect.Right, LineRect.Bottom); - tlVisibleTaskArray[tlVisibleItems].CheckRect := CheckRect; - LineRect.Top := LineRect.Bottom; - LineRect.Bottom := LineRect.Top + RowHeight; - Inc(tlVisibleItems); - end else if (LineRect.Bottom - TextMargin > RealBottom) then begin - FLastPrintLine := I; - Break; - end; - end; - if tlVisibleItems + tlItemsBefore = tlAllTaskList.Count then begin - FLastPrintLine := -2; - tlItemsAfter := 0; - end else begin - tlItemsAfter := tlAllTaskList.Count - tlItemsBefore - tlVisibleItems; - end; - - { these are for the syncing the scrollbar } - if StartLine < 0 then - tlItemsBefore := 0 - else - tlItemsBefore := StartLine; - end; - {-} - - procedure DrawHeader; - var - GlyphRect: TRect; - HeadStr: string; - begin - RenderCanvas.Brush.Color := TaskHeadAttrColor; - HeadRect.Left := RealLeft + 2; - HeadRect.Top := RealTop + 2; - HeadRect.Right := RealRight - 2; - - RenderCanvas.Font.Assign (FTaskHeadAttr.Font); - HeadRect.Bottom := RealTop + RenderCanvas.TextHeight ('YyGg0') + - TextMargin * 2; - TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect); - - { draw the header cell borders } - if FDrawingStyle = dsFlat then begin - { draw an outer and inner bevel } - - { wp: no bevel in flat style! - HeadRect.Left := HeadRect.Left - 1; - HeadRect.Top := HeadRect.Top - 1; - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, HeadRect), - BevelShadow, - BevelShadow); - } - end else if FDrawingStyle = ds3d then begin - { draw a 3d bevel } - HeadRect.Right := HeadRect.Right - 1; - DrawBevelRect (RenderCanvas, - TPSRotateRectangle (Angle, RenderIn, HeadRect), - BevelHighlight, - BevelDarkShadow); - end; - - if ShowIcon then begin - { Draw the glyph } - Bmp := Graphics.TBitmap.Create; - try - Bmp.LoadFromResourceName(HINSTANCE,'VPCHECKPAD'); //soner changed: Bmp.Handle := LoadBaseBitmap('VPCHECKPAD'); - { load and return the handle to bitmap resource} - if Bmp.Height > 0 then begin - GlyphRect.TopLeft := Point (HeadRect.Left + TextMargin, - HeadRect.Top + TextMargin); - GlyphRect.BottomRight := Point (GlyphRect.Left + Bmp.Width, - GlyphRect.Top + Bmp.Height); -//TODO: RenderCanvas.BrushCopy (TPSRotateRectangle (Angle, RenderIn, GlyphRect), -// Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), -// Bmp.Canvas.Pixels[0, Bmp.Height - 1]); - RenderCanvas.Draw(GlyphRect.TopLeft.x,GlyphRect.TopLeft.y,Bmp); //soner added - HeadRect.Left := HeadRect.Left + Bmp.Width + TextMargin; - end; - finally - Bmp.Free; - end; - end; - - { draw the text } - if ShowResourceName - and (DataStore <> nil) - and (DataStore.Resource <> nil) then - HeadStr := RSTaskTitleResource + DataStore.Resource.Description - else - HeadStr := RSTaskTitleNoResource; - RenderCanvas.Font.Assign(FTaskHeadAttr.Font); - TPSTextOut (RenderCanvas, Angle, RenderIn, HeadRect. - Left + TextMargin, HeadRect.Top + TextMargin, - HeadStr); - end; - {-} - - procedure DrawBorders; - begin - if FDrawingStyle = dsFlat then begin - { draw an outer and inner bevel } - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left, - RenderIn.Top, - RenderIn.Right - 1, - RenderIn.Bottom - 1), - BevelShadow, - BevelHighlight); - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left + 1, - RenderIn.Top + 1, - RenderIn.Right - 2, - RenderIn.Bottom - 2), - BevelHighlight, - BevelShadow); - end else if FDrawingStyle = ds3d then begin - { draw a 3d bevel } - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left, RenderIn.Top, - RenderIn.Right - 1, RenderIn.Bottom - 1), - BevelShadow, - BevelHighlight); - DrawBevelRect (RenderCanvas, - Rect (RenderIn.Left + 1, - RenderIn.Top + 1, - RenderIn.Right - 2, - RenderIn.Bottom - 2), - BevelDarkShadow, - BevelFace); - end; - end; - {-} -begin - if DisplayOnly then begin - RealColor := clWhite; - BackgroundSelHighlight := clBlack; - ForegroundSelHighlight := clWhite; - BevelShadow := clBlack; - BevelHighlight := clBlack; - BevelDarkShadow := clBlack; - BevelFace := clBlack; - RealLineColor := clBlack; - RealCheckBgColor := clWhite; - RealCheckBoxColor := clBlack; - RealCheckColor := clBlack; - RealCompleteColor := clBlack; - RealOverdueColor := clBlack; - RealNormalColor := clBlack; - TaskHeadAttrColor := clSilver; - end else begin - RealColor := Color; - BackgroundSelHighlight := clHighlight; - ForegroundSelHighlight := clHighlightText; - BevelShadow := clBtnShadow; - BevelHighlight := clBtnHighlight; - BevelDarkShadow := cl3DDkShadow; - BevelFace := clBtnFace; - RealLineColor := LineColor; - RealCheckBgColor := FDisplayOptions.CheckBGColor; - RealCheckBoxColor := FDisplayOptions.CheckColor; - RealCheckColor := FDisplayOptions.CheckColor; - RealCompleteColor := FDisplayOptions.FCompletedColor; - RealOverdueColor := FDisplayOptions.FOverdueColor; - RealNormalColor := FDisplayOptions.FNormalColor; - TaskHeadAttrColor := FTaskHeadAttr.Color; - end; - - tlPainting := true; - SavePenStyle := RenderCanvas.Pen.Style; - SaveBrushColor := RenderCanvas.Brush.Color; - SavePenColor := RenderCanvas.Pen.Color; - - RenderCanvas.Pen.Style := psSolid; - RenderCanvas.Pen.Width := 1; - RenderCanvas.Pen.Mode := pmCopy; - RenderCanvas.Brush.Style := bsSolid; - - Rgn := CreateRectRgn (RenderIn.Left, RenderIn.Top, - RenderIn.Right, RenderIn.Bottom); - try - SelectClipRgn (RenderCanvas.Handle, Rgn); - - if StartLine < 0 then - StartLine := 0; - - { clear client area } - Clear; - - SetMeasurements; - - { measure the row height } - MeasureRowHeight; - - { draw header } - DrawHeader; - - { draw lines } - DrawLines; - - { draw the tasks } - DrawTasks; - - { draw the borders } - DrawBorders; - - tlSetVScrollPos; - - finally - SelectClipRgn (RenderCanvas.Handle, 0); - DeleteObject (Rgn); - end; - - { reinstate canvas settings} - RenderCanvas.Pen.Style := SavePenStyle; - RenderCanvas.Brush.Color := SaveBrushColor; - RenderCanvas.Pen.Color := SavePenColor; - tlPainting := false; -end; -{=====} *) procedure TVpTaskList.SetColor(const Value: TColor); begin @@ -1228,14 +694,13 @@ begin if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then EndEdit(self); - if (Value < DataStore.Resource.Tasks.Count) - and (FTaskIndex <> Value) then begin + if (Value < DataStore.Resource.Tasks.Count) and (FTaskIndex <> Value) then + begin FTaskIndex := Value; if FTaskIndex > -1 then FActiveTask := DataStore.Resource.Tasks.GetTask(Value) else FActiveTask := nil; - Invalidate; end; end; @@ -1304,14 +769,14 @@ end; {=====} {$IFNDEF LCL} -procedure TVpTaskList.WMLButtonDown(var Msg : TWMLButtonDown); +procedure TVpTaskList.WMLButtonDown(var Msg: TWMLButtonDown); {$ELSE} -procedure TVpTaskList.WMLButtonDown(var Msg : TLMLButtonDown); +procedure TVpTaskList.WMLButtonDown(var Msg: TLMLButtonDown); {$ENDIF} begin inherited; - if not Focused then SetFocus; + if not Focused then SetFocus; if not (csDesigning in ComponentState) then begin {See if the user clicked on a checkbox} @@ -1321,14 +786,13 @@ end; {=====} {$IFNDEF LCL} -procedure TVpTaskList.WMRButtonDown (var Msg : TWMRButtonDown); +procedure TVpTaskList.WMRButtonDown(var Msg: TWMRButtonDown); {$ELSE} -procedure TVpTaskList.WMRButtonDown (var Msg : TLMRButtonDown); +procedure TVpTaskList.WMRButtonDown(var Msg: TLMRButtonDown); {$ENDIF} var - ClientOrigin : TPoint; - i : Integer; - + ClientOrigin: TPoint; + i: Integer; begin inherited; @@ -1339,7 +803,7 @@ begin tlClickTimer.Enabled := False; ClientOrigin := GetClientOrigin; - if not Assigned (FActiveTask) then + if not Assigned(FActiveTask) then for i := 0 to FDefaultPopup.Items.Count - 1 do begin if (FDefaultPopup.Items[i].Tag = 1) or (ReadOnly) then FDefaultPopup.Items[i].Enabled := False; @@ -1348,16 +812,15 @@ begin for i := 0 to FDefaultPopup.Items.Count - 1 do FDefaultPopup.Items[i].Enabled := True; - FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x, - Msg.YPos + ClientOrigin.y); + FDefaultPopup.Popup(Msg.XPos + ClientOrigin.x, Msg.YPos + ClientOrigin.y); end; end; {=====} {$IFNDEF LCL} -procedure TVpTaskList.WMLButtonDblClk(var Msg : TWMLButtonDblClk); +procedure TVpTaskList.WMLButtonDblClk(var Msg: TWMLButtonDblClk); {$ELSE} -procedure TVpTaskList.WMLButtonDblClk(var Msg : TLMLButtonDblClk); +procedure TVpTaskList.WMLButtonDblClk(var Msg: TLMLButtonDblClk); {$ENDIF} begin inherited; @@ -1366,45 +829,44 @@ begin if not Focused then SetFocus; { The mouse click landed inside the client area } - tlSetActiveTaskByCoord (Point (Msg.XPos, Msg.YPos)); + tlSetActiveTaskByCoord(Point(Msg.XPos, Msg.YPos)); { Spawn the TaskList editor } if not ReadOnly then - tlSpawnTaskEditDialog (FActiveTask = nil); + tlSpawnTaskEditDialog(FActiveTask = nil); end; {=====} procedure TVpTaskList.InitializeDefaultPopup; var - NewItem : TMenuItem; - + NewItem: TMenuItem; begin if RSTaskPopupAdd <> '' then begin - NewItem := TMenuItem.Create (Self); + NewItem := TMenuItem.Create(Self); NewItem.Caption := RSTaskPopupAdd; NewItem.OnClick := PopupAddTask; NewItem.Tag := 0; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSTaskPopupEdit <> '' then begin - NewItem := TMenuItem.Create (Self); + NewItem := TMenuItem.Create(Self); NewItem.Caption := RSTaskPopupEdit; NewItem.OnClick := PopupEditTask; NewItem.Tag := 1; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; if RSTaskPopupDelete <> '' then begin - NewItem := TMenuItem.Create (Self); + NewItem := TMenuItem.Create(Self); NewItem.Caption := RSTaskPopupDelete; NewItem.OnClick := PopupDeleteTask; NewItem.Tag := 1; - FDefaultPopup.Items.Add (NewItem); + FDefaultPopup.Items.Add(NewItem); end; end; {=====} -procedure TVpTaskList.PopupAddTask (Sender : TObject); +procedure TVpTaskList.PopupAddTask(Sender: TObject); begin if ReadOnly then Exit; @@ -1412,11 +874,11 @@ begin Exit; { Allow the user to fill in all the new information } Repaint; - tlSpawnTaskEditDialog (True); + tlSpawnTaskEditDialog(True); end; {=====} -procedure TVpTaskList.PopupDeleteTask (Sender : TObject); +procedure TVpTaskList.PopupDeleteTask(Sender: TObject); begin if ReadOnly then Exit; @@ -1427,7 +889,7 @@ begin end; {=====} -procedure TVpTaskList.PopupEditTask (Sender : TObject); +procedure TVpTaskList.PopupEditTask(Sender: TObject); begin if ReadOnly then Exit; @@ -1441,9 +903,9 @@ end; procedure TVpTaskList.tlSpawnTaskEditDialog(NewTask: Boolean); var - AllowIt : Boolean; - Task : TVpTask; - TaskDlg : TVpTaskEditDialog; + AllowIt: Boolean; + Task: TVpTask; + TaskDlg: TVpTaskEditDialog; begin tlClickTimer.Enabled := false; if not CheckCreateResource then @@ -1507,10 +969,9 @@ end; procedure TVpTaskList.EditTask; var - AllowIt : Boolean; - R : TRect; - VisTask : Integer; - + AllowIt: Boolean; + R: TRect; + VisTask: Integer; begin {don't allow a user to edit a completed task in place.} if FActiveTask.Complete then @@ -1573,63 +1034,65 @@ end; procedure TVpTaskList.KeyDown(var Key: Word; Shift: TShiftState); var - PopupPoint : TPoint; - + PopupPoint: TPoint; begin case Key of - VK_UP : + VK_UP: if TaskIndex > 0 then TaskIndex := TaskIndex - 1 else TaskIndex := Pred(DataStore.Resource.Tasks.Count); - VK_DOWN : + VK_DOWN: if TaskIndex < Pred(DataStore.Resource.Tasks.Count) then TaskIndex := TaskIndex + 1 else TaskIndex := 0; - VK_NEXT : - if TaskIndex < Pred (DataStore.Resource.Tasks.Count) - - tlVisibleItems then + VK_NEXT: + if TaskIndex < Pred(DataStore.Resource.Tasks.Count) - tlVisibleItems then TaskIndex := TaskIndex + tlVisibleItems else TaskIndex := Pred(DataStore.Resource.Tasks.Count); - VK_PRIOR : + VK_PRIOR : if TaskIndex > tlVisibleItems then TaskIndex := TaskIndex - tlVisibleItems else TaskIndex := 0; - VK_HOME : TaskIndex := 0; - VK_END : TaskIndex := Pred(DataStore.Resource.Tasks.Count); - VK_DELETE : DeleteActiveTask(true); - VK_RETURN : tlSpawnTaskEditDialog (False); - VK_INSERT : tlSpawnTaskEditDialog (True); - VK_F2 : if Assigned (DataStore) then begin - if Assigned (DataStore.Resource) then - tlEditInPlace (Self); - end; - VK_SPACE : - if Assigned (FActiveTask) then begin + VK_HOME: + TaskIndex := 0; + VK_END: + TaskIndex := Pred(DataStore.Resource.Tasks.Count); + VK_DELETE: + DeleteActiveTask(true); + VK_RETURN: + tlSpawnTaskEditDialog (False); + VK_INSERT: + tlSpawnTaskEditDialog (True); + VK_F2: + if Assigned(DataStore) then begin + if Assigned(DataStore.Resource) then + tlEditInPlace(Self); + end; + VK_SPACE: + if Assigned(FActiveTask) then begin FActiveTask.Complete := not FActiveTask.Complete; Invalidate; end; {$IFNDEF LCL} - VK_TAB : + VK_TAB: if ssShift in Shift then - Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, False)) + Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, False)) else - Windows.SetFocus (GetNextDlgTabItem(GetParent(Handle), Handle, True)); + Windows.SetFocus(GetNextDlgTabItem(GetParent(Handle), Handle, True)); {$ENDIF} - VK_F10 : - if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin + VK_F10: + if (ssShift in Shift) and not (Assigned(PopupMenu)) then begin PopupPoint := GetClientOrigin; - FDefaultPopup.Popup (PopupPoint.x + 10, - PopupPoint.y + 10); + FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; - VK_APPS : - if not Assigned (PopupMenu) then begin + VK_APPS: + if not Assigned(PopupMenu) then begin PopupPoint := GetClientOrigin; - FDefaultPopup.Popup (PopupPoint.x + 10, - PopupPoint.y + 10); + FDefaultPopup.Popup(PopupPoint.x + 10, PopupPoint.y + 10); end; end; @@ -1651,23 +1114,24 @@ begin if (tlInPlaceEditor <> nil) and tlInplaceEditor.Visible then Exit; case Msg.ScrollCode of - SB_LINEUP : + SB_LINEUP: if tlItemsBefore > 0 then tlItemsBefore := tlItemsBefore - 1; - SB_LINEDOWN : + SB_LINEDOWN: if tlItemsAfter > 0 then tlItemsBefore := tlItemsBefore + 1; - SB_PAGEUP : + SB_PAGEUP: if tlItemsBefore >= tlVisibleItems then tlItemsBefore := tlItemsBefore - tlVisibleItems else tlItemsBefore := 0; - SB_PAGEDOWN : + SB_PAGEDOWN: if tlItemsAfter >= tlVisibleItems then tlItemsBefore := tlItemsBefore + tlVisibleItems else tlItemsBefore := tlAllTaskList.Count - tlVisibleItems; - SB_THUMBPOSITION, SB_THUMBTRACK : tlItemsBefore := Msg.Pos; + SB_THUMBPOSITION, SB_THUMBTRACK: + tlItemsBefore := Msg.Pos; end; Invalidate; end; @@ -1675,13 +1139,10 @@ end; procedure TVpTaskList.tlSetVScrollPos; var - SI : TScrollInfo; + SI: TScrollInfo; begin - if (not HandleAllocated) - or (DataStore = nil) - or (DataStore.Resource = nil) - or (csDesigning in ComponentState) - then Exit; + if (not HandleAllocated) or (DataStore = nil) or (DataStore.Resource = nil) + or (csDesigning in ComponentState) then Exit; with SI do begin cbSize := SizeOf(SI); @@ -1698,7 +1159,7 @@ begin SetScrollInfo(Handle, SB_VERT, SI, True); end; {=====} -procedure TVpTaskList.SetShowIcon (const v : Boolean); +procedure TVpTaskList.SetShowIcon(const v: Boolean); begin if v <> FShowIcon then begin FShowIcon := v; @@ -1761,26 +1222,24 @@ begin end; {=====} -function TVpTaskList.tlVisibleTaskToTaskIndex (const VisTaskIndex : Integer) : Integer; +function TVpTaskList.tlVisibleTaskToTaskIndex(const VisTaskIndex: Integer): Integer; var - RealTask : TVpTask; - + RealTask: TVpTask; begin Result := -1; - if (VisTaskIndex < 0) or (VisTaskIndex >= Length (tlVisibleTaskArray)) then + if (VisTaskIndex < 0) or (VisTaskIndex >= Length(tlVisibleTaskArray)) then Exit; - RealTask := TVpTask (tlVisibleTaskArray[VisTaskIndex].Task); + RealTask := TVpTask(tlVisibleTaskArray[VisTaskIndex].Task); Result := RealTask.ItemIndex; end; -function TVpTaskList.tlTaskIndexToVisibleTask (const ATaskIndex : Integer) : Integer; +function TVpTaskList.tlTaskIndexToVisibleTask(const ATaskIndex: Integer): Integer; var - i : Integer; - + i: Integer; begin Result := -1; - for i := 0 to Length (tlVisibleTaskArray) - 1 do - if ATaskIndex = TVpTask (tlVisibleTaskArray[i].Task).ItemIndex then begin + for i := 0 to Length(tlVisibleTaskArray) - 1 do + if ATaskIndex = TVpTask(tlVisibleTaskArray[i].Task).ItemIndex then begin Result := i; Break; end;