home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / c / cbsdk10.zip / CALEND.PAS < prev    next >
Pascal/Delphi Source File  |  1992-11-07  |  6KB  |  252 lines
  1. Library Calend;
  2.  
  3. { Calend Add-In for the clySmic Icon Bar. (C) 1992 by clySmic Software.
  4.                                           All Rights reserved. }
  5.  
  6. {define Debug}
  7.  
  8. {$ifndef Debug}
  9. {$R-,I-,D-,L-,S-,V-,W-,G+}
  10. {$endif}
  11.  
  12. Uses
  13.   WinTypes,WinProcs,Strings,WinDOS;
  14.  
  15. {$R CALEND}
  16. {$I ADD-IN.INC}
  17.  
  18. Const
  19.   ShowDOW : Boolean = True;
  20.   CLBVer : VerString = '1.70';
  21.  
  22. Var
  23.   Yr,Mon,Day,DOW : Word;
  24.  
  25. {$D Calend Add-In for Clysbar. (C) 1992 by clySmic Software. All Rights Resv'd.}
  26.  
  27. {-----------------------------------------------}
  28.  
  29. { --- Utility Procedures --- }
  30.  
  31. Function CenterTx(DC : HDC; Tx : PChar; Rect : TRect) : Integer;
  32.  
  33. Var
  34.   Width,WinX,StrtX : Integer;
  35.  
  36. Begin
  37.   { Ask Windows for the total pixel length of the string & calc starting X }
  38.   Width := LoWord(GetTextExtent(DC,Tx,StrLen(Tx)));
  39.  
  40.   { Get total x width of window - don't add 1! }
  41.   WinX := (Rect.Right - Rect.Left);
  42.  
  43.   { Calculate centered starting posn }
  44.   StrtX := ((WinX - Width) Div 2) + Rect.Left;
  45.  
  46.   { Return }
  47.   CenterTx := StrtX;
  48. End {CenterTx};
  49.  
  50. {-----------------------------------------------}
  51.  
  52. { --- Perform Add-In's initialization --- }
  53.  
  54. Function InitAddIn(CurVer : PChar) : InitResult; Export;
  55.  
  56. Begin
  57.   { Version check }
  58.   If StrComp(CurVer,CLBVer) <> 0
  59.     Then InitAddIn := InitNotOk
  60.     Else InitAddIn := InitOk;
  61.  
  62. End {InitAddIn};
  63.  
  64. {-----------------------------------------------}
  65.  
  66. { --- Paint on the button (Clysbar does the background) --- }
  67.  
  68. Procedure PaintAddIn(Wnd : HWnd; DC : HDC; Pressed : Boolean); Export;
  69.  
  70. Const
  71.   MonthName : Array [1..12] of PChar =
  72.     ('JAN','FEB','MAR','APR','MAY','JUN',
  73.      'JUL','AUG','SEP','OCT','NOV','DEC');
  74.  
  75.   Days : array [0..6] of PChar =
  76.      ('SUN','MON','TUE','WED','THU','FRI','SAT');
  77.  
  78. Var
  79.   Rect : TRect;
  80.   NumFont,OldFont,SmlFont : HFont;
  81.   Tx : Array[0..128] of Char;
  82.   StrYr,StrDay : Array [0..4] of Char;
  83.   StrtX,StrtY : Integer;
  84.   TheIcon : HIcon;
  85.  
  86. Begin
  87.   GetClientRect(Wnd,Rect);
  88.  
  89.   { Calc location of icon }
  90.   StrtX := ((Rect.Right - Rect.Left) - GetSystemMetrics(sm_cxIcon)) Div 2;
  91.   StrtY := ((Rect.Bottom - Rect.Top) - GetSystemMetrics(sm_cyIcon)) Div 2;
  92.  
  93.   { Draw turning page if pressed }
  94.   If Pressed
  95.     Then Begin
  96.            TheIcon := LoadIcon(hInstance,'CALEND2');
  97.            DrawIcon(DC,StrtX+1,StrtY+1,TheIcon);
  98.  
  99.            Exit;
  100.          End;
  101.  
  102.   TheIcon := LoadIcon(hInstance,'CALEND');
  103.  
  104.   DrawIcon(DC,StrtX,StrtY,TheIcon);
  105.  
  106.   GetDate(Yr,Mon,Day,DOW);
  107.   Str(Day,StrDay);
  108.   Str(Yr,StrYr);
  109.  
  110.   SmlFont :=
  111.   CreateFont(9,             { Height }
  112.              0,0,0,         { Width, left 2 right, normal orientation }
  113.              400,           { Weight }
  114.              0,0,0,         { Italic, underlined, or strikeout }
  115.              0,             { ANSI char set }
  116.              0,             { Reserved precision field }
  117.              0,             { Default clipping }
  118.              Proof_Quality, { Quality }
  119.              ff_Roman Or Variable_Pitch,
  120.              'Small Fonts');
  121.  
  122.   NumFont :=
  123.   CreateFont(17,            { Height }
  124.              0,0,0,         { Width, left 2 right, normal orientation }
  125.              700,           { Weight }
  126.              0,0,0,         { Italic, underlined, or strikeout }
  127.              0,             { ANSI char set }
  128.              0,             { Reserved precision field }
  129.              0,             { Default clipping }
  130.              Proof_Quality, { Quality }
  131.              ff_Roman Or Variable_Pitch,
  132.              'Times New Roman');
  133.  
  134.   OldFont := SelectObject(DC,NumFont);
  135.  
  136.   SetBkMode(DC,Transparent);
  137.   SetTextColor(DC,RGB(0,0,0));
  138.  
  139.   Inc(Rect.Top,1);
  140.  
  141.   DrawText(DC,StrDay,StrLen(StrDay),Rect,
  142.            dt_Center or dt_VCenter or dt_SingleLine);
  143.  
  144.   SelectObject(DC,SmlFont);
  145.  
  146.   { Adjust rect to account for off-center pad image }
  147.   Dec(Rect.Right,2);
  148.  
  149.   StrCopy(Tx,MonthName[Mon]);
  150.   SetTextColor(DC,RGB(255,0,0));
  151.   TextOut(DC,CenterTx(DC,Tx,Rect),StrtY + 3,Tx,StrLen(Tx));
  152.  
  153.   If ShowDOW
  154.     Then Begin
  155.            StrCopy(Tx,Days[DOW]);
  156.            SetTextColor(DC,RGB(0,0,128));
  157.            TextOut(DC,CenterTx(DC,Tx,Rect),StrtY + 22,Tx,StrLen(Tx));
  158.          End
  159.     Else Begin
  160.            StrCopy(Tx,StrYr);
  161.            SetTextColor(DC,RGB(128,0,128));
  162.            TextOut(DC,CenterTx(DC,Tx,Rect),StrtY + 22,Tx,StrLen(Tx));
  163.          End;
  164.  
  165.   SelectObject(DC,OldFont);
  166.   DeleteObject(SmlFont);
  167.   DeleteObject(NumFont);
  168.  
  169. End {PaintAddIn};
  170.  
  171. {-----------------------------------------------}
  172.  
  173. { --- Tell Clysbar what kind of timer we need --- }
  174.  
  175. Function TimerNeeded : Integer; Export;
  176.  
  177. Begin
  178.   TimerNeeded := ait_Slow;
  179. End {TimerNeeded};
  180.  
  181. {-----------------------------------------------}
  182.  
  183. { --- Proc called when timer expires, perform timed duties --- }
  184.  
  185. Procedure AddInTimer(Wnd : HWnd; DC : HDC); Export;
  186.  
  187. Var
  188.   TimerDay : Word;
  189.  
  190. Begin
  191.   { Check for a date change }
  192.   GetDate(Yr,Mon,TimerDay,DOW);
  193.  
  194.   { If different, repaint window }
  195.   If TimerDay <> Day
  196.     Then PaintAddIn(Wnd,DC,False);
  197.  
  198. End {AddInTimer};
  199.  
  200. {-----------------------------------------------}
  201.  
  202. { --- Proc called when button pressed --- }
  203.  
  204. Procedure AddInPressed(Wnd : HWnd; DC : HDC); Export;
  205.  
  206. Begin
  207.   { Toggle the "show day-of-week" indicator when button pressed }
  208.   ShowDOW := Not ShowDOW;
  209.   PaintAddIn(Wnd,DC,False);
  210. End {AddInPressed};
  211.  
  212. {-----------------------------------------------}
  213.  
  214. { --- Exit processing for Add-In --- }
  215.  
  216. Procedure ExitAddIn; Export;
  217.  
  218. Begin
  219. End {ExitAddIn};
  220.  
  221. {-----------------------------------------------}
  222.  
  223. { --- Clysbar queries Add-In about itself --- }
  224.  
  225. Procedure AddInAbout(Str1,Str2 : PChar;
  226.                      Var TheIcon : HIcon;
  227.                      Var TitleCol,TxCol,BkCol : TColorRef); Export;
  228.  
  229. Begin
  230.   StrCopy(Str1,'Calend V1.70');
  231.   StrCopy(Str2,'A Page-per-Day Calendar'#13'⌐ 1992 by clySmic Software.'#13'All Rights Reserved.');
  232.  
  233.   TheIcon := LoadIcon(hInstance,'ABOUT');
  234.  
  235.   TitleCol := RGB(0,0,255);
  236.   TxCol := RGB(0,0,128);
  237.   BkCol := RGB(192,192,192);
  238. End {AddInAbout};
  239.  
  240. {-----------------------------------------------}
  241.  
  242. Exports InitAddIn    Index 1,
  243.         PaintAddIn   Index 2,
  244.         TimerNeeded  Index 3,
  245.         AddInTimer   Index 4,
  246.         AddInPressed Index 5,
  247.         ExitAddIn    Index 6,
  248.         AddInAbout   Index 7;
  249.  
  250. Begin
  251. End.
  252.