Advertisement

04.18.2008 at 12:55PM PDT, ID: 23335401
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
7.8

Adding On Click Event to TVpMonthView

Asked by Romans in Delphi Programming Language

Tags:

Hi,
I downloaded and installed Turbo Power Visual Planit from source forge.

    http://sourceforge.net/projects/tpvplanit/

Well the TVpMonthView component does not appear to have an OnClick Event so - I decided to embark into something I've never done before. My journey ended up here so you know already how successful I've been.

Anyways - I have added TVpOnCalClick event in the attached code. I tried to replicate the TVpOnEventClick which comes with the component - but I don't see the event in the object inspector.

Can somebody give me a hand adding an On CLick event to this component.

Thanks
RomansStart Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
1066:
1067:
1068:
1069:
1070:
1071:
1072:
1073:
1074:
1075:
1076:
1077:
1078:
1079:
1080:
1081:
1082:
1083:
1084:
1085:
1086:
1087:
1088:
1089:
1090:
1091:
1092:
1093:
1094:
1095:
1096:
1097:
1098:
1099:
1100:
1101:
1102:
1103:
1104:
1105:
1106:
1107:
1108:
1109:
1110:
1111:
1112:
1113:
1114:
1115:
1116:
1117:
1118:
1119:
1120:
1121:
1122:
1123:
1124:
1125:
1126:
1127:
1128:
1129:
1130:
1131:
1132:
1133:
1134:
1135:
1136:
1137:
1138:
1139:
1140:
1141:
1142:
1143:
1144:
1145:
1146:
1147:
1148:
1149:
1150:
1151:
1152:
1153:
1154:
1155:
1156:
1157:
1158:
1159:
1160:
1161:
1162:
1163:
1164:
1165:
1166:
1167:
1168:
1169:
1170:
1171:
1172:
1173:
1174:
1175:
1176:
1177:
1178:
1179:
1180:
1181:
1182:
1183:
1184:
1185:
1186:
1187:
1188:
1189:
1190:
1191:
1192:
1193:
1194:
1195:
1196:
1197:
1198:
1199:
1200:
1201:
1202:
1203:
1204:
1205:
1206:
1207:
1208:
1209:
1210:
1211:
1212:
1213:
1214:
1215:
1216:
1217:
1218:
1219:
1220:
1221:
1222:
1223:
1224:
1225:
1226:
1227:
1228:
1229:
1230:
1231:
1232:
1233:
1234:
1235:
1236:
1237:
1238:
1239:
1240:
1241:
1242:
1243:
1244:
1245:
1246:
1247:
1248:
1249:
1250:
1251:
1252:
1253:
1254:
1255:
1256:
1257:
1258:
1259:
1260:
1261:
1262:
1263:
1264:
1265:
1266:
1267:
1268:
1269:
1270:
1271:
1272:
1273:
1274:
1275:
1276:
1277:
1278:
1279:
1280:
1281:
1282:
1283:
1284:
1285:
1286:
1287:
1288:
1289:
1290:
1291:
1292:
1293:
1294:
1295:
1296:
1297:
1298:
1299:
1300:
1301:
1302:
1303:
1304:
1305:
1306:
1307:
1308:
1309:
1310:
1311:
1312:
1313:
1314:
1315:
1316:
1317:
1318:
1319:
1320:
1321:
1322:
1323:
1324:
1325:
1326:
1327:
1328:
1329:
1330:
1331:
1332:
1333:
1334:
1335:
1336:
1337:
1338:
1339:
1340:
1341:
1342:
1343:
1344:
1345:
1346:
1347:
1348:
1349:
1350:
1351:
1352:
1353:
1354:
1355:
1356:
1357:
1358:
1359:
1360:
1361:
1362:
1363:
1364:
1365:
1366:
1367:
1368:
1369:
1370:
1371:
1372:
1373:
1374:
1375:
1376:
1377:
1378:
1379:
1380:
1381:
1382:
1383:
1384:
1385:
1386:
1387:
1388:
1389:
1390:
1391:
1392:
1393:
1394:
1395:
1396:
1397:
1398:
1399:
1400:
1401:
1402:
1403:
1404:
1405:
1406:
1407:
1408:
1409:
1410:
1411:
1412:
1413:
1414:
1415:
1416:
1417:
1418:
1419:
1420:
1421:
1422:
1423:
1424:
1425:
1426:
1427:
1428:
1429:
1430:
1431:
1432:
1433:
1434:
1435:
1436:
1437:
1438:
1439:
1440:
1441:
1442:
1443:
1444:
1445:
1446:
1447:
1448:
1449:
1450:
1451:
1452:
1453:
1454:
1455:
1456:
1457:
1458:
1459:
1460:
1461:
1462:
1463:
1464:
1465:
1466:
1467:
1468:
1469:
1470:
1471:
1472:
1473:
1474:
1475:
1476:
1477:
1478:
1479:
1480:
1481:
1482:
1483:
1484:
1485:
1486:
1487:
1488:
1489:
1490:
1491:
1492:
1493:
1494:
1495:
1496:
1497:
1498:
1499:
1500:
1501:
1502:
1503:
1504:
1505:
1506:
1507:
1508:
1509:
1510:
1511:
1512:
1513:
1514:
1515:
1516:
1517:
1518:
1519:
1520:
1521:
1522:
1523:
1524:
1525:
1526:
1527:
1528:
1529:
1530:
1531:
1532:
1533:
1534:
1535:
1536:
1537:
1538:
1539:
1540:
1541:
1542:
1543:
1544:
1545:
1546:
1547:
1548:
1549:
1550:
1551:
1552:
1553:
1554:
1555:
1556:
1557:
1558:
1559:
1560:
1561:
1562:
1563:
1564:
1565:
1566:
1567:
1568:
1569:
1570:
1571:
1572:
1573:
1574:
1575:
1576:
1577:
1578:
1579:
1580:
1581:
1582:
1583:
1584:
1585:
1586:
1587:
1588:
1589:
1590:
1591:
1592:
1593:
1594:
1595:
1596:
1597:
1598:
1599:
1600:
1601:
1602:
1603:
1604:
1605:
1606:
1607:
1608:
1609:
1610:
1611:
1612:
1613:
1614:
1615:
1616:
1617:
1618:
1619:
1620:
1621:
1622:
1623:
1624:
1625:
1626:
1627:
1628:
1629:
1630:
1631:
1632:
1633:
1634:
1635:
1636:
1637:
1638:
1639:
1640:
1641:
1642:
1643:
1644:
1645:
1646:
1647:
1648:
1649:
1650:
1651:
1652:
1653:
1654:
1655:
1656:
1657:
1658:
1659:
1660:
1661:
1662:
1663:
1664:
1665:
1666:
1667:
1668:

{*********************************************************}
{*                VPMONTHVIEW.PAS 1.03                   *}
{*********************************************************}
 
{* ***** BEGIN LICENSE BLOCK *****                                            *}
{* Version: MPL 1.1                                                           *}
{*                                                                            *}
{* The contents of this file are subject to the Mozilla Public License        *}
{* Version 1.1 (the "License"); you may not use this file except in           *}
{* compliance with the License. You may obtain a copy of the License at       *}
{* http://www.mozilla.org/MPL/                                                *}
{*                                                                            *}
{* Software distributed under the License is distributed on an "AS IS" basis, *}
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License   *}
{* for the specific language governing rights and limitations under the       *}
{* License.                                                                   *}
{*                                                                            *}
{* The Original Code is TurboPower Visual PlanIt                              *}
{*                                                                            *}
{* The Initial Developer of the Original Code is TurboPower Software          *}
{*                                                                            *}
{* Portions created by TurboPower Software Inc. are Copyright (C) 2002        *}
{* TurboPower Software Inc. All Rights Reserved.                              *}
{*                                                                            *}
{* Contributor(s):                                                            *}
{*                                                                            *}
{* ***** END LICENSE BLOCK *****                                              *}
 
{$I Vp.INC}
 
unit VpMonthView;
 
interface
 
uses
  Windows, Classes, Graphics, Controls, ComCtrls, ExtCtrls, Messages, StdCtrls,
  VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpConst, VpCanvasUtils, Menus;
 
type
  TVpMonthdayRec = packed record
    Rec     : TRect;
    Date    : TDateTime;
    OffDay  : Boolean;
  end;
 
type
  TVpMonthdayArray = array of TVpMonthdayRec;
 
  { Forward Declarations }
  TVpMonthView = class;
 
  TVpMVDayNameStyle = (dsLong, dsShort, dsLetter);
 
  TVpOnCalClick =
    procedure(Sender: TObject) of object;
 
  TVpOnEventClick =
    procedure(Sender: TObject; Event: TVpEvent) of object;
 
 
  TVpDayHeadAttr = class(TPersistent)
  protected{private}
    FMonthView: TVpMonthView;
    FFont: TFont;
    FColor: TColor;
    procedure SetColor (Value: TColor);
    procedure SetFont (Value: TFont);
  public
    constructor Create(AOwner: TVpMonthView);
    destructor Destroy; override;
    property MonthView: TVpMonthView read FMonthView;
  published
    property Color: TColor read FColor write SetColor;
    property Font: TFont read FFont write SetFont;
  end;
 
  TVpMonthView = class(TVpLinkableControl)
  protected{ private }
    FKBNavigate        : Boolean;
    FColumnWidth       : Integer;
    FColor             : TColor;
    FLineColor         : TColor;
    FLineCount         : Integer;
    FVisibleLines      : Integer;
    FDayNameStyle      : TVpMVDayNameStyle;
    FOffDayColor       : TColor;
    FSelectedDayColor  : TColor;
    FWeekStartsOn      : TVpDayType;
    FShowEvents        : Boolean;
    FEventDayStyle     : TFontStyles;
    FDateLabelFormat   : string;
    FShowEventTime     : Boolean;
    FTopLine           : Integer;
    FDayHeadAttributes : TVpDayHeadAttr;
    FDayNumberFont     : TFont;
    FEventFont         : TFont;
    FTimeFormat        : TVpTimeFormat;
    FDrawingStyle      : TVpDrawingStyle;
    FDate              : TDateTime;
    FDefaultPopup      : TPopupMenu;
    FRightClickChangeDate : Boolean;                                     
    { event variables }
    FOwnerDrawCells    : TVpOwnerDrawDayEvent;
    FOnEventClick      : TVpOnEventClick;
    FOnEventDblClick   : TVpOnEventClick;
    FOnCalClick        : TVpOnCalClick;
 
    { internal variables }
    mvDayNumberHeight  : Integer;
    mvEventTextHeight  : Integer;
    mvLoaded           : Boolean;
    mvInLinkHandler    : Boolean;
    mvRowHeight        : Integer;
    mvLineHeight       : Integer;
    mvColWidth         : Integer;
    mvDayHeadHeight    : Integer;
    mvSpinButtons      : TUpDown;
    mvEventArray       : TVpEventArray;
    mvMonthDayArray    : TVpMonthdayArray;
    mvActiveEvent      : TVpEvent;
    mvActiveEventRec   : TRect;
    mvEventList        : TList;
    mvCreatingEditor   : Boolean;
    mvPainting         : Boolean;
    mvVScrollDelta     : Integer;
    mvHotPoint         : TPoint;
    mvVisibleEvents    : Integer;                                        
 
    { property methods }
    procedure SetDrawingStyle(Value: TVpDrawingStyle);
    procedure SetColor(Value: TColor);
    procedure SetLineColor(Value: TColor);
    procedure SetOffDayColor(Value: TColor);
    procedure SetDateLabelFormat(Value: string);
    procedure SetShowEvents(Value: Boolean);
    procedure SetEventDayStyle(Value: TFontStyles);
    procedure SetDayNameStyle(Value: TVpMVDayNameStyle);
    procedure SetDayNumberFont(Value: TFont);
    procedure SetEventFont(Value: TFont);
    procedure SetSelectedDayColor(Value: TColor);
    procedure SetShowEventTime(Value: Boolean);
    procedure SetTimeFormat(Value: TVpTimeFormat);
    procedure SetDate(Value: TDateTime);
    procedure SetRightClickChangeDate (const v : Boolean);               
    procedure SetWeekStartsOn(Value: TVpDayType);
    { internal methods }
    procedure mvHookUp;
    procedure mvFontChanged(Sender: TObject);
 
    procedure Paint; override;
    procedure Loaded; override;
    procedure InitializeDefaultPopup;
    procedure mvPopulate;
    procedure mvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure WMLButtonDown(var Msg : TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClick(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    { - renamed from EditEventAtCoord and re-written}
    function  SelectEventAtCoord(Point: TPoint): Boolean;
    procedure mvSetDateByCoord(Point: TPoint);
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    { message handlers }
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
    procedure WMRButtonDown(var Msg : TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey);
      message CM_WANTSPECIALKEY;
    procedure PopupToday (Sender : TObject);
    procedure PopupNextMonth (Sender : TObject);
    procedure PopupPrevMonth (Sender : TObject);
    procedure PopupNextYear (Sender : TObject);
    procedure PopupPrevYear (Sender : TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure LinkHandler(Sender: TComponent;
      NotificationType: TVpNotificationType;
      const Value: Variant); override;
    function GetControlType : TVpItemType; override;
    procedure PaintToCanvas (ACanvas : TCanvas;
                             ARect   : TRect;
                             Angle   : TVpRotationAngle;
                             ADate   : TDateTime);
    procedure RenderToCanvas (RenderCanvas : TCanvas;
                              RenderIn     : TRect;
                              Angle        : TVpRotationAngle;
                              Scale        : Extended;
                              RenderDate   : TDateTime;
                              StartLine    : Integer;
                              StopLine     : Integer;
                              UseGran      : TVpGranularity;
                              DisplayOnly  : Boolean); override;
 
 
  published
    { inherited properties }
    property Date: TDateTime read FDate write SetDate;
    property Align;
    property Anchors;
    property TabStop;
    property TabOrder;
    property KBNavigation: Boolean
      read FKBNavigate write FKBNavigate;
    property Color: TColor
      read FColor write SetColor;
    property DateLabelFormat:
      string read FDateLabelFormat write SetDateLabelFormat;
    property DayHeadAttributes: TVpDayHeadAttr
      read FDayHeadAttributes write FDayHeadAttributes;
    property DayNameStyle: TVpMVDayNameStyle
      read FDayNameStyle write SetDayNameStyle;
    property DayNumberFont: TFont
      read FDayNumberFont write SetDayNumberFont;
    property DrawingStyle: TVpDrawingStyle
      read FDrawingStyle write SetDrawingStyle;
    property EventDayStyle: TFontStyles
      read FEventDayStyle write SetEventDayStyle;
    property EventFont: TFont
      read FEventFont write SetEventFont;
    property LineColor: TColor
      read FLineColor write SetLineColor;
    property TimeFormat: TVpTimeFormat
      read FTimeFormat write SetTimeFormat;
    property OffDayColor: TColor
      read FOffDayColor write SetOffDayColor;
    property OwnerDrawCells: TVpOwnerDrawDayEvent
      read FOwnerDrawCells write FOwnerDrawCells;
    property RightClickChangeDate : Boolean                              
             read FRightClickChangeDate write SetRightClickChangeDate    
             default vpDefWVRClickChangeDate;                            
    property SelectedDayColor: TColor
      read FSelectedDayColor write SetSelectedDayColor;
    property ShowEvents: Boolean
      read FShowEvents write SetShowEvents;
    property ShowEventTime: Boolean
      read FShowEventTime write SetShowEventTime;
    property WeekStartsOn : TVpDayType
      read FWeekStartsOn write SetWeekStartsOn;
    {events}
    property OnEventClick: TVpOnEventClick                               
      read FOnEventClick write FOnEventClick;
    property OnEventDblClick: TVpOnEventClick
      read FOnEventDblClick write FOnEventDblClick;
    property OnCalClick:   TVpOnCalClick
      read FOnCalClick write FOnCalClick;
  end;
 
implementation
 
uses
  SysUtils, Math, Forms, Dialogs, VpEvntEditDlg;
 
(*****************************************************************************)
{ TVpContactHeadAttr }
constructor TVpDayHeadAttr.Create(AOwner: TVpMonthView);
begin
  inherited Create;
  FMonthView := AOwner;
  FFont := TFont.Create;
  FFont.Assign(FMonthView.Font);
  FFont.Size := 8;
  FColor := clSilver;
end;
{=====}
 
//procedure TVpMonthView.Click;
//begin
  //  if Assigned(FOnClick) then FOnClick(Self);
//end;
 
destructor TVpDayHeadAttr.Destroy;
begin
  FFont.Free;
end;
{=====}
 
procedure TVpDayHeadAttr.SetColor(Value: TColor);
begin
  if Value <> FColor then begin
    FColor := Value;
    MonthView.Invalidate;
  end;
end;
{=====}
 
procedure TVpDayHeadAttr.SetFont(Value: TFont);
begin
  if Value <> FFont then begin
    FFont.Assign(Value);
    MonthView.Invalidate;
  end;
end;
{=====}
 
(*****************************************************************************)
{ TVpMonthView }
 
constructor TVpMonthView.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
 
  { Create internal classes and stuff }
  FDayHeadAttributes := TVpDayHeadAttr.Create(self);
  mvEventList := TList.Create;
  mvSpinButtons := TUpDown.Create(self);
 
  { Set styles and initialize internal variables }
  {$IFDEF VERSION4}
  DoubleBuffered := true;
  {$ENDIF}
  FShowEvents := true;
  FEventDayStyle := [];
  FShowEventTime := false;
  FDayNameStyle :=dsShort;
  FKBNavigate := true;
  mvInLinkHandler := false;
  mvSpinButtons.OnClick := mvSpinButtonClick;
  mvSpinButtons.Orientation := udHorizontal;
  mvSpinButtons.Min := -32768;
  mvSpinButtons.Max := 32767;
  mvCreatingEditor := false;
  FSelectedDayColor := clRed;
  FDrawingStyle := ds3d;
  mvPainting := false;
  FColor := clWindow;
  FOffDayColor := clSilver;
  FLineColor := clGray;
  FDate := Trunc(Now);
  FTimeFormat := tf12Hour;
  FDateLabelFormat := 'mmmm yyyy';
  FColumnWidth := 200;
  FRightClickChangeDate := vpDefWVRClickChangeDate;                      
  mvVisibleEvents := 0;                                                  
 
  { set up fonts and colors }
  FDayHeadAttributes.Font.Name := 'Tahoma';
  FDayHeadAttributes.Font.Size := 10;
  FDayHeadAttributes.Font.Style := [];
  FDayHeadAttributes.Color := clBtnFace;
 
  { Assign default font to DayNumberFont and EventFont }
  FDayNumberFont := TFont.Create;
  FDayNumberFont.Assign(Font);
  FDayNumberFont.OnChange := mvFontChanged;
  FEventFont := TFont.Create;
  FEventFont.Assign(Font);
  FEventFont.OnChange := mvFontChanged;
 
  SetLength(mvEventArray, MaxVisibleEvents);
  SetLength(mvMonthdayArray, 45);
 
  { size }
  Height := 225;
  Width := 300;
 
  FDefaultPopup := TPopupMenu.Create (Self);
  InitializeDefaultPopup;
 
  mvHookUp;
end;
{=====}
 
destructor TVpMonthView.Destroy;
begin
  FDayHeadAttributes.Free;
  FDayNumberFont.Free;
  FEventFont.Free;
  mvSpinButtons.Free;
  mvEventList.Free;
  FDefaultPopup.Free;
  inherited;
end;
{=====}
 
procedure TVpMonthView.Invalidate;
begin
  inherited;
end;
{=====}
 
procedure TVpMonthView.LinkHandler(Sender: TComponent;
  NotificationType: TVpNotificationType; const Value: Variant);
begin
  mvInLinkHandler := true;
  try
    case NotificationType of
      neDateChange: Date := Value;
      neDataStoreChange: Invalidate;
      neInvalidate: Invalidate;
    end;
  finally
    mvInLinkHandler := false;
  end;
end;
{=====}
 
procedure TVpMonthView.mvHookUp;
var
  I: Integer;
begin
  { If the component is being dropped on a form at designtime, then }
  { automatically hook up to the first datastore component found    }
  if csDesigning in ComponentState then
    for I := 0 to pred(Owner.ComponentCount) do begin
      if (Owner.Components[I] is TVpCustomDataStore) then begin
        DataStore := TVpCustomDataStore(Owner.Components[I]);
        Exit;
      end;
    end;
end;
{=====}
 
procedure TVpMonthView.mvFontChanged(Sender: TObject);
begin
  Invalidate;
end;
{=====}
 
procedure TVpMonthView.Loaded;
begin
  inherited;
  mvLoaded := true;
  mvPopulate;
end;
{=====}
 
function TVpMonthView.GetControlType : TVpItemType;
begin
  Result := itMonthView;
end;
 
procedure TVpMonthView.Paint;
begin
  RenderToCanvas (Canvas,
                  Rect (0, 0, Width, Height),
                  ra0,
                  1,
                  Self.Date,
                  -1,
                  -1,
                  gr30Min,
                  False);
end;
{=====}
procedure TVpMonthView.PaintToCanvas (ACanvas : TCanvas;
                                       ARect   : TRect;
                                       Angle   : TVpRotationAngle;
                                       ADate   : TDateTime);
begin
  RenderToCanvas (ACanvas, ARect, Angle, 1, ADate,
                  -1, -1, gr30Min, True);
end;
{=====}
procedure TVpMonthView.RenderToCanvas (RenderCanvas : TCanvas;
                                       RenderIn     : TRect;
                                       Angle        : TVpRotationAngle;
                                       Scale        : Extended;
                                       RenderDate   : TDateTime;
                                       StartLine    : Integer;
                                       StopLine     : Integer;
                                       UseGran      : TVpGranularity;
                                       DisplayOnly  : Boolean);
var
  HeadRect       : TRect;
  SaveBrushColor : TColor;
  SavePenStyle   : TPenStyle;
  SavePenColor   : TColor;
  DisplayDate    : TDateTime;
 
  RealWidth      : Integer;
  RealHeight     : Integer;
  RealLeft       : Integer;
  RealRight      : Integer;
  RealTop        : Integer;
  RealBottom     : Integer;
  Rgn            : HRGN;
 
  RealColor        : TColor;
  BevelHighlight   : TColor;
  BevelShadow      : TColor;
  BevelDarkShadow  : TColor;
  BevelFace        : TColor;
  DayHeadAttrColor : TColor;
  RealLineColor    : TColor;
  RealOffDayColor  : TColor;
  RealSelDayColor  : TColor;
  EventFontColor   : TColor;
  DotDotDotColor   : TColor;
 
  procedure Clear;
  begin
    RenderCanvas.Brush.Color := RealColor;
    RenderCanvas.FillRect(RenderIn);
  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);
 
    if RenderDate = 0 then
      DisplayDate := Date
    else
      DisplayDate := RenderDate;
 
    { we use the VpProductName because is is a good representation of some }
    { generic text }
    RenderCanvas.Font.Assign(FDayHeadAttributes.Font);
    mvDayHeadHeight := RenderCanvas.TextHeight(VpProductName) + TextMargin + 2;
    RenderCanvas.Font.Assign(FDayNumberFont);
    mvDayNumberHeight := RenderCanvas.TextHeight('00');
    RenderCanvas.Font.Assign(FEventFont);
    mvEventTextHeight := RenderCanvas.TextHeight(VpProductName);
    RenderCanvas.Font.Assign(Font);
    mvLineHeight := RenderCanvas.TextHeight(VpProductName) + 2;
    mvColWidth   := (RealWidth - 4) div 7;
  end;
  {-}
 
  procedure DrawHeader;
  var
    HeadTextRect: TRect;
    HeadStr: string;
    HeadStrLen : Integer;
  begin
    RenderCanvas.Brush.Color := DayHeadAttrColor;
    { draw the header cell and borders }
 
    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      HeadRect.Left := RealLeft + 1;
      HeadRect.Top := RealTop + 1;
      HeadRect.Right := RealRight - 1;
      HeadRect.Bottom := RealTop + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, HeadRect),
                     BevelHighlight, BevelShadow);
    end else if FDrawingStyle = ds3d then begin
      { draw a 3d bevel }
      HeadRect.Left := RealLeft + 2;
      HeadRect.Top := RealTop + 2;
      HeadRect.Right := RealRight - 3;
      HeadRect.Bottom := RealTop + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, HeadRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, HeadRect),
                     BevelHighlight, BevelDarkShadow);
    end;
 
    { Acquire startdate and end date }
    HeadStr := FormatDateTime(DateLabelFormat, DisplayDate);
 
    { draw the text }
    if (DisplayOnly) and
       (RenderCanvas.TextWidth (HeadStr) >= RealWidth) then
      HeadTextRect.TopLeft:= Point (RealLeft + TextMargin * 2,
                                    HeadRect.Top)
    else if DisplayOnly then
      HeadTextRect.TopLeft := Point (RealLeft +
                                     (RealWidth -
                                     RenderCanvas.TextWidth (HeadStr)) div 2,
                                     HeadRect.Top)
    else
      HeadTextRect.TopLeft := Point (RealLeft + 30 + TextMargin * 2,
                                     HeadRect.Top);
    HeadTextRect.BottomRight := HeadRect.BottomRight;
 
    { Fix Header String }
    HeadStrLen := RenderCanvas.TextWidth(HeadStr);
 
    if HeadStrLen > HeadTextRect.Right - HeadTextRect.Left then begin
      HeadStr := GetDisplayString(RenderCanvas, HeadStr, 0,
        HeadTextRect.Right - HeadTextRect.Left - TextMargin);
    end;
 
    { position the spinner }
    mvSpinButtons.Height := Trunc(mvDayHeadHeight * 0.8);
    mvSpinButtons.Width := mvSpinButtons.Height * 2;
    mvSpinButtons.Left := TextMargin;
    mvSpinButtons.Top := (mvDayHeadHeight - mvSpinButtons.Height) div 2 + 2;
 
    RenderCanvas.Font.Assign (FDayHeadAttributes.Font);
    TPSTextOut (RenderCanvas, Angle, RenderIn,
                RealLeft + mvSpinButtons.Width + TextMargin * 2,
                HeadTextRect.Top + TextMargin, HeadStr);
  end;
  {-}
 
  procedure DrawDayHead;
  var
    dhRect : TRect;
    I      : Integer;
    DayTag : Integer;
    Str    : string;
    StrL   : Integer;
  begin
    { clear day head area }
    RenderCanvas.Font.Assign(DayHeadAttributes.Font);
    RenderCanvas.Brush.Color := DayHeadAttrColor;
 
    { build rect }
    if DrawingStyle = ds3D then begin
      dhRect.Left := RealLeft + 1;
      dhRect.Top := RealTop + mvDayHeadHeight + 3;
      dhRect.Right := RealRight - 3;
      dhRect.Bottom := dhRect.Top + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, dhRect),
                     BevelHighlight, BevelDarkShadow);
    end else begin
      dhRect.Left := RealLeft + 1;
      dhRect.Top := RealTop + mvDayHeadHeight + 2;
      dhRect.Right := RealRight - 1;
      dhRect.Bottom := dhRect.Top + mvDayHeadHeight;
      TPSFillRect (RenderCanvas, Angle, RenderIn, dhRect);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle, RenderIn, dhRect),
                     BevelHighlight, BevelShadow);
    end;
 
    DayTag := Ord(WeekStartsOn);
    dhRect.Right := dhRect.Left + mvColWidth;
    for I := 0 to 6 do begin
      { draw the little vertical lines between each day }
      if I < 6 then
        DrawBevelRect (RenderCanvas,
                       TPSRotateRectangle (Angle, RenderIn,
                                           Rect (dhRect.Right,
                                                 dhRect.Top + 3,
                                                 dhRect.Right + 1,
                                                 dhRect.Bottom - 3)),
                       BevelShadow, BevelHighlight);
 
      if FDayNameStyle = dsLong then
        { Draw each day's full caption... }
        case DayTag of
          0: str := RSSunday;
          1: str := RSMonday;
          2: str := RSTuesday;
          3: str := RSWednesday;
          4: str := RSThursday;
          5: str := RSFriday;
          6: str := RSSaturday;
        end
      else if FDayNameStyle = dsShort then
        { Draw each day's abbreviated caption... }
        case DayTag of
          0: str := RSASunday;
          1: str := RSAMonday;
          2: str := RSATuesday;
          3: str := RSAWednesday;
          4: str := RSAThursday;
          5: str := RSAFriday;
          6: str := RSASaturday;
        end
      else if FDayNameStyle = dsLetter then
        { Draw each day's first letter only }
        case DayTag of
          0: str := RSLSunday;
          1: str := RSLMonday;
          2: str := RSLTuesday;
          3: str := RSLWednesday;
          4: str := RSLThursday;
          5: str := RSLFriday;
          6: str := RSLSaturday;
        end;
 
      { Fix Header String }
      StrL := RenderCanvas.TextWidth(Str);
      if (StrL > mvColWidth - (TextMargin * 2)) then begin
        Str := GetDisplayString (RenderCanvas, Str, 0,
                                 mvColWidth - (TextMargin * 2));
      end;
      StrL := RenderCanvas.TextWidth(Str);
 
      TPSTextOut (RenderCanvas, Angle, RenderIn,
                  dhRect.Left + (dhRect.Right - dhRect.Left) div 2 -
                  (Strl div 2), dhRect.Top + TextMargin - 1, Str);
 
      if DayTag = 6 then
        DayTag := 0
      else
        Inc(DayTag);
      dhRect.Left := dhRect.Right;
      dhRect.Right := dhRect.Left + mvColWidth;
    end;
 
  end;
  {-}
 
  procedure DrawDays;
  var
    TextRect      : TRect;
    Col, Row      : Integer;
    DayNumber     : Integer;
    M, D, Y, Tmp  : Word;
    MonthStartsOn : Integer;
    DayTag        : Integer;
    DayOffset     : Integer;
    StartingDate  : TDateTime;
    ThisDate      : TDateTime;
    Str           : string;
    StrLn         : Integer;
    I, J          : Integer;
    EventList     : TList;
    Drawn         : Boolean;
    TextAdjust    : Integer;
    FontStyle     : TFontStyles;
    OldBrush      : TBrush;
    OldPen        : TPen;
    OldFont       : TFont;
  begin
    { initialize the MonthDayArray }
    for I := 0 to Pred(Length(mvMonthDayArray)) do begin
      mvMonthDayArray[I].Rec     := Rect(-1, -1, -1, -1);
      mvMonthDayArray[I].Date    := 0.0;
    end;
 
    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Brush.Color := RealColor;
    mvRowHeight := (RealHeight - (mvDayHeadHeight * 2) - 4) div 6;
    TextRect.TopLeft := Point (RealLeft + 1,
                               RealTop + (mvDayHeadHeight * 2) + 4);
    TextRect.BottomRight := Point (TextRect.Left +  mvColWidth,
                                   TextRect.Top + mvRowHeight);
 
    { Determine the starting date and offset }
    DecodeDate(DisplayDate, Y, M, D);
    StartingDate := EncodeDate(Y, M, 1);
    MonthStartsOn := DayOfWeek(StartingDate);
    DayTag := Ord(WeekStartsOn);
    DayOffset := DayTag - MonthStartsOn;
 
    I := 0;
    DayNumber := DayOffset + 1;
 
    { iterate through each column, row by row, drawing each day in numerical }
    { order.                                                                 }
 
    OldBrush := TBrush.Create;
    try
      OldPen := TPen.Create;
      try
        OldFont := TFont.Create;
        try
          for Row := 0 to 5 do begin
            for Col := 0 to 6 do begin
              if (Col = 6) then begin
                { draws the far right day for this week }
                ThisDate := trunc(StartingDate + DayNumber);
                DecodeDate(ThisDate, Y, Tmp, D);
 
                { Allow the user to draw the day }
                Drawn  := false;
                if Assigned(FOwnerDrawCells) then begin
                  OldBrush.Assign (Canvas.Brush);
                  OldPen.Assign (Canvas.Pen);
                  OldFont.Assign (Canvas.Font);
                  try
                    FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
                    if Drawn then continue;
                  finally
                    Canvas.Brush.Assign (OldBrush);
                    Canvas.Pen.Assign (OldPen);
                    Canvas.Font.Assign (OldFont);
                  end;
                end;
 
                TextRect.Right := TextRect.Right + 8;
                if Tmp <> M then begin
                  RenderCanvas.Brush.Color := RealOffDayColor;
                  if TextRect.Bottom > RealBottom then
                    TPSFillRect (RenderCanvas, Angle, RenderIn,
                                 Rect (TextRect.Left, TextRect.Top,
                                       RealRight, RealBottom))
                  else
                    TPSFillRect (RenderCanvas, Angle, RenderIn,
                                 Rect (TextRect.Left, TextRect.Top,
                                       RealRight, TextRect.Bottom));
                end else
                  RenderCanvas.Brush.Color := RealColor;
                { draw bottom line }
                TPSMoveTo (RenderCanvas, Angle, RenderIn,
                           TextRect.Left, TextRect.Bottom);
                TPSLineTo (RenderCanvas, Angle, RenderIn, RealRight - 2,
                           TextRect.Bottom);
                { Paint the day number }
                Str := FormatDateTime('d', ThisDate);
 
                { set the proper font and style }
                RenderCanvas.Font.Assign(FDayNumberFont);
                if (DisplayDate = ThisDate) then begin
                  if Focused then begin
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left - 2,
                                            TextRect.Top - 2,
                                            TextRect.Right + 2,
                                            TextRect.Bottom + 2));
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left + 2,
                                            TextRect.Top + 2,
                                            TextRect.Right - 2,
                                            TextRect.Bottom - 2));
                  end;
                  RenderCanvas.Font.Color := RealSelDayColor;
                  RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold];
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle;
                end else begin
                  { Set the font style for days which have events. }
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle
                  else begin
                    RenderCanvas.Font.Color := EventFontColor;
                    RenderCanvas.Font.Style := FDayNumberFont.Style;
                  end;
                end;
 
                FontStyle := RenderCanvas.Font.Style;
                RenderCanvas.Font.Style := [fsBold, fsItalic];
                TextAdjust := RenderCanvas.TextWidth (Str);
                RenderCanvas.Font.Style := FontStyle;
 
                { write the day number at the top of the square. }
                if fsItalic in RenderCanvas.Font.Style then
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Left + mvColWidth - TextAdjust -
                              TextMargin - 2,
                              TextRect.Top + (TextMargin div 2), Str)
                else
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Left + mvColWidth - TextAdjust
                                - TextMargin, TextRect.Top + (TextMargin div 2),
                                Str);
 
 
                { Update MonthDayArray }
                mvMonthDayArray[I].Rec := TextRect;
                mvMonthDayArray[I].Date := ThisDate;
                mvMonthDayArray[I].OffDay := Tmp <> M;
                Inc(DayNumber);
                Inc(I);
 
                { drop rect down one row and all the way to the left }
                TextRect.TopLeft := Point(RealLeft + 1, TextRect.Bottom + 1);
                TextRect.BottomRight := Point(TextRect.Left + mvColWidth,
                  TextRect.Top + mvRowHeight);
              end else begin
                { draws all days for the week, except the far right one }
                ThisDate := Trunc(StartingDate + DayNumber);
                DecodeDate(ThisDate, Y, Tmp, D);
 
                { Allow the user to draw the day }
                Drawn  := false;
                if Assigned(FOwnerDrawCells) then begin
                  OldBrush.Assign (Canvas.Brush);
                  OldPen.Assign (Canvas.Pen);
                  OldFont.Assign (Canvas.Font);
                  try
                    FOwnerDrawCells(self, RenderCanvas, TextRect, D, Drawn);
                    if Drawn then continue;
                  finally
                    Canvas.Brush.Assign (OldBrush);
                    Canvas.Pen.Assign (OldPen);
                    Canvas.Font.Assign (OldFont);
                  end;
                end;
 
                if Tmp <> M then begin
                  RenderCanvas.Brush.Color := RealOffDayColor;
                  TPSFillRect (RenderCanvas, Angle, RenderIn, TextRect);
                end else
                  RenderCanvas.Brush.Color := RealColor;
                { draw right side and bottom lines }
                TPSMoveTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                  TextRect.top);
                if TextRect.Bottom > RealBottom then begin
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                    RealBottom);
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1,
                    RealBottom);
                end else begin
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Right,
                    TextRect.Bottom);
                  TPSLineTo (RenderCanvas, Angle, RenderIn, TextRect.Left - 1,
                    TextRect.Bottom);
                end;
                { paint the day number }
                Str := FormatDateTime('d', ThisDate);
 
                { set the proper font and style }
                RenderCanvas.Font.Assign(FDayNumberFont);
                if (DisplayDate = ThisDate) then begin
                  if Focused then begin
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left - 2,
                                            TextRect.Top - 2,
                                            TextRect.Right + 2,
                                            TextRect.Bottom + 2));
                    TPSDrawFocusRect (RenderCanvas, Angle, RenderIn,
                                      Rect (TextRect.Left + 2,
                                            TextRect.Top + 2,
                                            TextRect.Right - 2,
                                            TextRect.Bottom - 2));
                  end;
                  RenderCanvas.Font.Color := RealSelDayColor;
                  RenderCanvas.Font.Style := FDayNumberFont.Style + [fsBold];
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle;
                end else begin
                  { Set the font style for days which have events. }
                  if (FEventDayStyle <> []) and (DataStore.Resource <> nil)
                  and (DataStore.Resource.Schedule.EventCountByDay(ThisDate) > 0)
                  then
                    RenderCanvas.Font.Style := RenderCanvas.Font.Style
                      + FEventDayStyle
                  else begin
                    RenderCanvas.Font.Color := EventFontColor;
                    RenderCanvas.Font.Style := FDayNumberFont.Style;
                  end;
                end;
 
                FontStyle := RenderCanvas.Font.Style;
                RenderCanvas.Font.Style := [fsBold, fsItalic];
                TextAdjust := RenderCanvas.TextWidth (Str);
                RenderCanvas.Font.Style := FontStyle;
 
                if fsItalic in RenderCanvas.Font.Style then
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Right - TextAdjust - TextMargin - 2,
                              TextRect.Top + (TextMargin div 2), Str)
                else
                  TPSTextOut (RenderCanvas, Angle, RenderIn,
                              TextRect.Right - TextAdjust - TextMargin,
                              TextRect.Top + (TextMargin div 2), Str);
 
                { Update Array }
                mvMonthDayArray[I].Rec := TextRect;
                mvMonthDayArray[I].Date := ThisDate;
                mvMonthDayArray[I].OffDay := Tmp <> M;
                Inc(DayNumber);
                Inc(I);
                { slide rect one column to the right }
                TextRect.Left := TextRect.Right + 1;
                TextRect.Right := TextRect.Right + mvColWidth;
              end;
            end;
          end;
 
        finally
          OldFont.Free;
        end;
      finally
        OldPen.Free;
      end;
    finally
      OldBrush.Free;
    end;
 
    RenderCanvas.Pen.Color := RealLineColor;
    RenderCanvas.Pen.Style := psSolid;
    RenderCanvas.Brush.Color := RealColor;
 
    { write the events }
    if (DataStore <> nil) and FShowEvents and (DataStore.Resource <> nil)
    and (DataStore.Resource.Schedule.EventCount <> 0) then begin
      EventList := TList.Create;
      try
        for I := 0 to 43 do begin
          EventList.Clear;
          DataStore.Resource.Schedule.EventsByDate(mvMonthDayArray[I].Date, EventList);
          if EventList.Count > 0 then begin
            { there are events scheduled for this day }
 
            { initialize TextRect for this day }
            TextRect.TopLeft := Point(mvMonthDayArray[I].Rec.Left,
              mvMonthDayArray[I].Rec.Top);
            TextRect.BottomRight := Point(TextRect.Left + mvColWidth,
              TextRect.Top + mvEventTextHeight + (TextMargin div 2));
 
            { set canvas color }
            if mvMonthDayArray[I].OffDay
            then RenderCanvas.Brush.Color := RealOffDayColor
            else RenderCanvas.Brush.Color := RealColor;
 
            { spin through the events and paint them }
            for J := 0 to Pred(EventList.Count) do begin
 
              if (TextRect.Bottom > mvMonthDayArray[I].Rec.Bottom)
              and (J <= Pred(EventList.Count))
              then begin
                { draw a little red square with a (...) at the bottom right }
                { corner of the day to indicate that there are more events  }
                { than can be listed in the available space.                }
                RenderCanvas.Brush.Color := DotDotDotColor;
                { draw dot dot dot }
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right - 20,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right - 17,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right - 13,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right - 10,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                TPSFillRect (RenderCanvas, Angle, RenderIn,
                             Rect(mvMonthDayArray[I].Rec.Right -  6,
                                     mvMonthDayArray[I].Rec.Bottom - 7,
                                     mvMonthDayArray[I].Rec.Right -  3,
                                     mvMonthDayArray[I].Rec.Bottom - 4));
                Break;
              end;
 
              { shorten events that are next to the day number, in order }
              { to give the day number enough room }
              if (TextRect.Top < mvMonthDayArray[I].Rec.Top
                + mvDayNumberHeight + (TextMargin div 2))
              then
                TextRect.Right := TextRect.Left + mvColWidth
                  - mvDayNumberHeight - TextMargin
              else
                TextRect.Right := TextRect.Left + mvColWidth;
 
              { format the display text }
              if ShowEventTime then begin
                if (TimeFormat = tf24Hour) then
                  Str := FormatDateTime('hh:mm',
                    TVpEvent(EventList.List^[j]).StartTime)
                else
                  Str := FormatDateTime('hh:mm AM/PM',
                    TVpEvent(EventList.List^[j]).StartTime);
                Str := Str + ' - ' + TVpEvent(EventList.List^[j]).Description;
              end else
                Str := TVpEvent(EventList.List^[j]).Description;
 
              { set the event font }
              RenderCanvas.Font.Assign(FEventFont);
 
              StrLn := RenderCanvas.TextWidth(Str);
              if (StrLn > TextRect.Right - TextRect.Left - (TextMargin * 2)) then
              begin
                Str := GetDisplayString(RenderCanvas, Str, 0, TextRect.Right -
                  TextRect.Left - (TextMargin * 2));
              end;
 
              { write the event text }
              TPSTextOut (RenderCanvas, Angle, RenderIn, TextRect.Left + (TextMargin div 2),
                TextRect.Top + (TextMargin div 2), Str);
 
              { - begin block}
              Inc(mvVisibleEvents);
              mvEventArray[mvVisibleEvents - 1].Rec := TextRect;
              mvEventArray[mvVisibleEvents - 1].Event := TVpEvent(EventList.List^[j]);
              { - end block}
 
              { Move TextRect down one line for the next item... }
              TextRect.Top := TextRect.Bottom + 1;
              TextRect.Bottom := TextRect.Top + mvLineHeight;
            end;
          end;
        end;
      finally
        EventList.Free;
      end;
    end;
  end;
  {-}
 
 
  procedure DrawBorders;
  begin
    if FDrawingStyle = dsFlat then begin
      { draw an outer and inner bevel }
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft,
                                               RealTop,
                                               RealRight - 1,
                                               RealBottom - 1)),
                     BevelShadow,
                     BevelShadow);
    end else if FDrawingStyle = ds3d then begin
    { draw a 3d bevel }
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft,
                                               RealTop,
                                               RealRight - 1,
                                               RealBottom - 1)),
                     BevelShadow,
                     BevelHighlight);
      DrawBevelRect (RenderCanvas,
                     TPSRotateRectangle (Angle,
                                         RenderIn,
                                         Rect (RealLeft + 1,
                                               RealTop +  1,
                                               RealRight - 2,
                                               RealBottom - 2)),
                     BevelDarkShadow,
                     BevelFace);
    end;
  end;
  {-}
begin
  if DisplayOnly then begin
    BevelHighlight   := clBlack;
    BevelShadow      := clBlack;
    BevelDarkShadow  := clBlack;
    BevelFace        := clBlack;
    RealColor        := clWhite;
    DayHeadAttrColor := clSilver;
    RealLineColor    := clBlack;
    RealOffDayColor  := clSilver;
    RealSelDayColor  := clWhite;
    EventFontColor   := clBlack;
  end else begin
    BevelHighlight   := clBtnHighlight;
    BevelShadow      := clBtnShadow;
    BevelDarkShadow  := cl3DDkShadow;
    BevelFace        := clBtnFace;
    RealColor        := Color;
    DayHeadAttrColor := DayHeadAttributes.Color;
    RealLineColor    := LineColor;
    RealOffDayColor  := OffDayColor;
    RealSelDayColor  := FSelectedDayColor;
    EventFontColor   := FDayNumberFont.Color;
  end;
  DotDotDotColor := clBlack;
 
  mvPainting := 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);
 
    { clear client area }
    Clear;
 
    { measure the row heights }
    SetMeasurements;
 
    { draw headers }
    DrawHeader;
    DrawDayHead;
 
    { draw days }
    mvVisibleEvents := 0;                                                
    DrawDays;
 
    { draw the borders }
    DrawBorders;
 
  finally
    SelectClipRgn (RenderCanvas.Handle, 0);
    DeleteObject (Rgn);
  end;
 
  { reinstate canvas settings}
  RenderCanvas.Pen.Style := SavePenStyle;
  RenderCanvas.Brush.Color := SaveBrushColor;
  RenderCanvas.Pen.Color := SavePenColor;
  mvPainting := false; 
end;
 
procedure TVpMonthView.mvPopulate;
begin
  if DataStore <> nil then
    DataStore.Date := FDate;
end;
{=====}
 
procedure TVpMonthView.mvSpinButtonClick(Sender: TObject; Button: TUDBtnType);
var
  M, D, Y : Word;
begin
  DecodeDate(Date, Y, M, D);
  if Button = btNext then begin
    if M = 12 then begin
      M := 1;
      Y := Y + 1;
    end else
      M := M + 1;
  end else begin
    if M = 1 then begin
      M := 12;
      Y := Y - 1;
    end else
      M := M - 1;
  end;
  if (D > DaysInMonth(Y, M)) then
    D := DaysInMonth(Y, M);
 
  Date := EncodeDate(Y, M, D);
end;
{=====}
 
procedure TVpMonthView.SetColor(Value: TColor);
begin
  if FColor <> Value then begin
    FColor := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetDrawingStyle(Value: TVpDrawingStyle);
begin
  if FDrawingStyle <> Value then begin
    FDrawingStyle := Value;
    Repaint;
  end;
end;
{=====}
 
procedure TVpMonthView.SetLineColor(Value: TColor);
begin
  if FLineColor <> Value then begin
    FLineColor := Value;
    Repaint;
  end;
end;
{=====}
 
procedure TVpMonthView.SetOffDayColor(Value: TColor);
begin
  if Value <> FOffDayColor then begin
    FOffDayColor := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetDateLabelFormat(Value: string);
begin
  if Value <> FDateLabelFormat then begin
    FDateLabelFormat := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetShowEvents(Value: Boolean);
begin
  if FShowEvents <> Value then begin
    FShowEvents := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetEventDayStyle(Value: TFontStyles);
begin
  if FEventDayStyle <> Value then begin
    FEventDayStyle := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetDayNameStyle(Value: TVpMVDayNameStyle);
begin
  if FDayNameStyle <> Value then begin
    FDayNameStyle := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetDayNumberFont(Value: TFont);
begin
  FDayNumberFont.Assign(Value);
  Invalidate;
end;
{=====}
 
procedure TVpMonthView.SetEventFont(Value: TFont);
begin
  FEventFont.Assign(Value);
  Invalidate;
end;
{=====}
 
procedure TVpMonthView.SetSelectedDayColor(Value: TColor);
begin
  if Value <> FSelectedDayColor then begin
    FSelectedDayColor := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetShowEventTime(Value: Boolean);
begin
  if Value <> FShowEventTime then begin
    FShowEventTime := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetTimeFormat(Value: TVpTimeFormat);
begin
  if Value <> FTimeFormat then begin
    FTimeFormat := Value;
    Invalidate;
  end;
end;
{=====}
 
procedure TVpMonthView.SetDate(Value: TDateTime);
begin
  if FDate <> Trunc(Value) then begin
    FDate := Trunc(Value);
 
    if DataStore <> nil then
      DataStore.Date := FDate;
 
    if mvLoaded then
      mvPopulate;
    Invalidate;
 
    if ControlLink <> nil then
      ControlLink.Notify(self, neDateChange, FDate);
  end;
end;
{=====}
 
procedure TVpMonthView.WMSize(var Msg: TWMSize);
begin
  inherited;
  { force a repaint on resize }
  Invalidate;
end;
{=====}
 
procedure TVpMonthView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_TABSTOP;
    WindowClass.style := CS_DBLCLKS;
  end;
end;
{=====}
 
procedure TVpMonthView.CreateWnd;
begin
  inherited;
  mvSpinButtons.Parent := self;
end;
{=====}
 
procedure TVpMonthView.WMLButtonDown(var Msg : TWMLButtonDown);
begin
  inherited;
  // if the mouse was pressed down in the client area, then select the cell.
  if not focused then SetFocus;
 
  if (Msg.YPos > mvDayHeadHeight) then
  begin
    { The mouse click landed inside the client area }
    MvSetDateByCoord(Point(Msg.XPos, Msg.YPos));
    { Did the mouse click land on an event? }
    if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos))
    and (Assigned(FOnEventClick)) then
        FOnEventClick(self, mvActiveEvent);
 
    if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos))
    and (Assigned(FOnCalClick)) then
      FOnCalClick(self);
  end;
end;
{=====}
 
procedure TVpMonthView.WMLButtonDblClick(var Msg: TWMLButtonDblClk);     
begin                                                                    
  inherited;                                                             
  // if the mouse was pressed down in the client area, then select the   
  // cell.                                                               
  if not focused then SetFocus;                                          
                                                                         
  if (Msg.YPos > mvDayHeadHeight) then                                   
  begin                                                                  
    { The mouse click landed inside the client area }                    
    MvSetDateByCoord(Point(Msg.XPos, Msg.YPos));                         
    { Did the mouse click land on an event? }                            
    if SelectEventAtCoord(Point(Msg.XPos, Msg.YPos))
    and (Assigned(FOnEventDblClick)) then
      FOnEventDblClick(self, mvActiveEvent);
  end;
end;                                                                     
{=====}                                                                  
 
procedure TVpMonthView.WMSetFocus(var Msg : TWMSetFocus);
begin
  // if active event is nil then set active event to the first diaplsyed one.
end;
{=====}
 
procedure TVpMonthView.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
begin
  inherited;
  Msg.Result := 1;
end;
{=====}
 
procedure TVpMonthView.WMRButtonDown(var Msg : TWMRButtonDown);
var
  ClientOrigin : TPoint;
 
begin
  inherited;
 
  if not Assigned (PopupMenu) then begin
    if not focused then
      SetFocus;
    if FRightClickChangeDate then                                        
      mvSetDateByCoord (Point (Msg.XPos, Msg.YPos));                     
    ClientOrigin := GetClientOrigin;
 
    FDefaultPopup.Popup (Msg.XPos + ClientOrigin.x,
                         Msg.YPos + ClientOrigin.y);
  end;
end;
{=====}
 
procedure TVpMonthView.InitializeDefaultPopup;
var
  NewItem : TMenuItem;
 
begin
  if RSMonthPopupToday <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupToday;
    NewItem.OnClick := PopupToday;
    FDefaultPopup.Items.Add (NewItem);
  end;
 
  if RSMonthPopupNextMonth <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupNextMonth;
    NewItem.OnClick := PopupNextMonth;
    FDefaultPopup.Items.Add (NewItem);
  end;
 
  if RSMonthPopupPrevMonth <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupPrevMonth;
    NewItem.OnClick := PopupPrevMonth;
    FDefaultPopup.Items.Add (NewItem);
  end;
 
  if RSMonthPopupNextYear <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupNextYear;
    NewItem.OnClick := PopupNextYear;
    FDefaultPopup.Items.Add (NewItem);
  end;
 
  if RSMonthPopupPrevYear <> '' then begin
    NewItem := TMenuItem.Create (Self);
    NewItem.Caption := RSMonthPopupPrevYear;
    NewItem.OnClick := PopupPrevYear;
    FDefaultPopup.Items.Add (NewItem);
  end;
end;
{=====}
 
procedure TVpMonthView.PopupToday (Sender : TObject);
begin
  Date := Now;
end;
{=====}
 
procedure TVpMonthView.PopupNextMonth (Sender : TObject);
begin
  mvSpinButtonClick (self, btNext);
end;
{=====}
 
procedure TVpMonthView.PopupPrevMonth (Sender : TObject);
begin
  mvSpinButtonClick (self, btPrev);
end;
{=====}
 
procedure TVpMonthView.PopupNextYear (Sender : TObject);
var
  M, D, Y : Word;
 
begin
  DecodeDate (Date, Y, M, D);
  Date := EncodeDate (Y + 1, M, 1);
end;
{=====}
 
procedure TVpMonthView.PopupPrevYear (Sender : TObject);
var
  M, D, Y : Word;
 
begin
  DecodeDate (Date, Y, M, D);
  Date := EncodeDate (Y - 1, M, 1);
end;
{=====}
 
{ - renamed from EditEventAtCoord and re-written}
function TVpMonthView.SelectEventAtCoord(Point: TPoint): Boolean;        
var
  I: Integer;
begin
  result := false;
  I := 0;
  while I < Length(mvEventArray) do begin
    if mvEventArray[I].Event = nil then begin
      Inc(I);
      Break;
    end else begin
      if (Point.X > mvEventArray[I].Rec.Left)
      and (Point.X < mvEventArray[I].Rec.Right)
      and (Point.Y > mvEventArray[I].Rec.Top)
      and (Point.Y < mvEventArray[I].Rec.Bottom) then begin
        result := true;
        Break;
      end else
        Inc(I);
    end;
  end;
 
  if result then begin
    mvActiveEvent := TVpEvent(mvEventArray[I].Event);
    mvActiveEventRec := mvEventArray[I].Rec;
  end;
end;
{=====}
 
procedure TVpMonthView.mvSetDateByCoord(Point: TPoint);
var
  I: Integer;
begin
  for I := 0 to pred(Length(mvMonthdayArray)) do begin
    if (Point.X >= mvMonthdayArray[I].Rec.Left)
    and (Point.X <= mvMonthdayArray[I].Rec.Right)
    and (Point.Y >= mvMonthdayArray[I].Rec.Top)
    and (Point.Y <= mvMonthdayArray[I].Rec.Bottom) then
      Date := mvMonthdayArray[I].Date;
  end;
end;
{=====}
 
procedure TVpMonthView.KeyDown(var Key: Word; Shift: TShiftState);
var
  M, D, Y    : Word;
  PopupPoint : TPoint;
 
begin
  if FKBNavigate then
    case Key of
      VK_UP    :
        if ssCtrl in Shift then begin
          DecodeDate(Date, Y, M, D);
          Date := EncodeDate(Y - 1, M, 1);
        end else
          Date := Date - 7;
      VK_DOWN  :
        if ssCtrl in Shift then begin
          DecodeDate(Date, Y, M, D);
          Date := EncodeDate(Y + 1, M, 1);
        end else
          Date := Date + 7;
      VK_NEXT  : mvSpinButtonClick(self, btNext);
      VK_PRIOR : mvSpinButtonClick(self, btPrev);
      VK_LEFT  :
        if ssCtrl in Shift then
          mvSpinButtonClick(self, btPrev)
        else
          Date := Date - 1;
      VK_RIGHT :
        if ssCtrl in Shift then
          mvSpinButtonClick(self, btNext)
        else
          Date := Date + 1;
      VK_HOME  : begin
        DecodeDate(Date, Y, M, D);
        if D = 1 then
          mvSpinButtonClick(self, btPrev)
        else
          Date := EncodeDate(Y, M, 1);
      end;
      VK_END   : begin
        DecodeDate(Date, Y, M, D);
        if D = DaysInMonth(Y, M) then begin
          if M = 12 then begin
            M := 1;
            Inc(Y);
          end else
            Inc(M);
        end;
        Date := EncodeDate(Y, M, DaysInMonth(Y, M));
      end;
      VK_TAB   :
        if ssShift in Shift then
          Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, False))
        else
          Windows.SetFocus (GetNextDlgTabItem (GetParent (Handle), Handle, True));
      VK_F10   :
        if (ssShift in Shift) and not (Assigned (PopupMenu)) then begin
          PopupPoint := GetClientOrigin;
          FDefaultPopup.Popup (PopupPoint.x + 10,
                               PopupPoint.y + 10);
        end;
      VK_APPS  :
        if not Assigned (PopupMenu) then begin
          PopupPoint := GetClientOrigin;
          FDefaultPopup.Popup (PopupPoint.x + 10,
                               PopupPoint.y + 10);
        end;
    end;
end;
{=====}
procedure TVpMonthView.SetRightClickChangeDate (const v : Boolean);      
begin                                                                    
  if v <> FRightClickChangeDate then                                     
    FRightClickChangeDate := v;                                          
end;                                                                     
{=====}
procedure TVpMonthView.SetWeekStartsOn(Value: TVpDayType);
begin
  if Value <> FWeekStartsOn then begin
    FWeekStartsOn := Value;
    Invalidate;
  end;
end;
{=====}
 
end.
[+][-]04.21.2008 at 03:50AM PDT, ID: 21400238

Experts Exchange has a courteous staff of administrators who help members get the most out of the website by means of administrative comments like this one.

Start your 7-day free trial to view this Administrative Comment or ask the Experts your question.

 
[+][-]04.23.2008 at 05:02AM PDT, ID: 21419633

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zone: Delphi Programming Language
Tags: Delphi
Sign Up Now!
Solution Provided By: GRFrones
Participating Experts: 1
Solution Grade: A
 
 
[+][-]04.23.2008 at 05:40AM PDT, ID: 21419931

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628