home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 February / Chip_2004-02_cd1.bin / program / delphi / navody / d56 / ec1vr2.exe / #setuppath# / Delphi / CalendarMaker / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-12-09  |  8.9 KB  |  340 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   vivrep20, Menus, Grids, DBGrids, StdCtrls, Buttons, ExtCtrls, Db, Math,
  8.   DBTables, ImgList, ActnList, ComCtrls, ToolWin, ExtDlgs, Mask
  9. {$IFDEF VER140}
  10. , Variants
  11. {$ENDIF}
  12. ;
  13.  
  14. type
  15.   TMainForm = class(TForm)
  16.     MainMenu: TMainMenu;
  17.     FilePrintItem: TMenuItem;
  18.     FilePrintSetupItem: TMenuItem;
  19.     FileExitItem: TMenuItem;
  20.     HelpAboutItem: TMenuItem;
  21.     Preview: TMenuItem;
  22.     N1: TMenuItem;
  23.     LoadPicture1: TMenuItem;
  24.     N251: TMenuItem;
  25.     N501: TMenuItem;
  26.     N1001: TMenuItem;
  27.     N2001: TMenuItem;
  28.     N4001: TMenuItem;
  29.     ZoomMenu: TMenuItem;
  30.     N252: TMenuItem;
  31.     N502: TMenuItem;
  32.     N1002: TMenuItem;
  33.     N2002: TMenuItem;
  34.     N4002: TMenuItem;
  35.     ImageList: TImageList;
  36.     ActionList: TActionList;
  37.     ExitAction: TAction;
  38.     PrintSetupAction: TAction;
  39.     PrintAction: TAction;
  40.     PrintPreviewAction: TAction;
  41.     AboutAction: TAction;
  42.       LoadAction: TAction;
  43.     Zoom25Action: TAction;
  44.     Zoom50Action: TAction;
  45.     Zoom100Action: TAction;
  46.     Zoom200Action: TAction;
  47.     Zoom400Action: TAction;
  48.     ToolBar1: TToolBar;
  49.     ToolButton1: TToolButton;
  50.     ToolButton2: TToolButton;
  51.     ToolButton3: TToolButton;
  52.     ToolButton4: TToolButton;
  53.     ToolButton5: TToolButton;
  54.     ToolButton6: TToolButton;
  55.     ToolButton7: TToolButton;
  56.     ToolButton8: TToolButton;
  57.     ToolButton9: TToolButton;
  58.     ToolButton10: TToolButton;
  59.     ToolButton11: TToolButton;
  60.     Panel1: TPanel;
  61.     Label1: TLabel;
  62.     Label2: TLabel;
  63.     YearEdit: TMaskEdit;
  64.     TextEdit: TMemo;
  65.     PopupMenu1: TPopupMenu;
  66.     LoadDialog: TOpenPictureDialog;
  67.     SpeedButton1: TSpeedButton;
  68.     DBGrid1: TDBGrid;
  69.     HolidaysTable: TTable;
  70.     HolidaysSource: TDataSource;
  71.     HolidaysTableDate: TDateField;
  72.     Report: TVividReport;
  73.     VRPage1: TVRPage;
  74.     VRBand1: TVRBand;
  75.     PictureLabel: TVRLabel;
  76.     YearLabel: TVRLabel;
  77.     TextLabel: TVRLabel;
  78.     ShadowLabel: TVRLabel;
  79.     VRBand4: TVRBand;
  80.     VRBand2: TVRBand;
  81.     VRBand3: TVRBand;
  82.     VRBand5: TVRBand;
  83.     MonthsGrid: TVRGrid;
  84.     PrintProgress: TVRPrintProgress;
  85.     PrintPreview: TVRPreview;
  86.  
  87.  
  88.     procedure ExitActionExecute(Sender: TObject);
  89.     procedure AboutActionExecute(Sender: TObject);
  90.     procedure PrintSetupActionExecute(Sender: TObject);
  91.     procedure PrintActionExecute(Sender: TObject);  
  92.     procedure PrintPreviewActionExecute(Sender: TObject);
  93.     procedure LoadActionExecute(Sender: TObject);
  94.     procedure Zoom25ActionExecute(Sender: TObject);
  95.     procedure Zoom50ActionExecute(Sender: TObject);
  96.     procedure Zoom100ActionExecute(Sender: TObject);
  97.     procedure Zoom200ActionExecute(Sender: TObject);
  98.     procedure Zoom400ActionExecute(Sender: TObject);
  99.  
  100.     procedure YearEditExit(Sender: TObject);
  101.     procedure YearEditKeyPress(Sender: TObject; var Key: Char);
  102.     procedure YearLabelCalcValue(Sender: TObject);
  103.     procedure TextEditChange(Sender: TObject);
  104.     procedure ShadowLabelCalcValue(Sender: TObject);
  105.     procedure HolidaysTableDateGetText(Sender: TField; var Text: String; DisplayText: Boolean);
  106.     procedure HolidaysTableDateSetText(Sender: TField; const Text: String);
  107.     procedure HolidaysTableAfterPost(DataSet: TDataSet);
  108.  
  109.     procedure MonthsGridCells0CalcValue(Sender: TObject);
  110.     procedure MonthsGridColumns0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  111.     procedure MonthsGridRows0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  112.     procedure MonthsGridCells1CalcValue(Sender: TObject);
  113.     procedure MonthsGridColumns0SubItems0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  114.     procedure MonthsGridRows0SubItems2EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  115.     procedure MonthsGridCells2CalcValue(Sender: TObject);
  116.     procedure MonthsGridColumns0SubItems1BeginPrint(Sender: TObject; var APrint: TBeforeAction);
  117.   private
  118.     { Private declarations }
  119.   public
  120.     { Public declarations }
  121.     Year: Integer;
  122.     MonthsCol: Integer;
  123.     Row: Integer;
  124.     WeekDay: Integer;
  125.     Week: Integer;
  126.  
  127.     constructor Create (AOwner: TComponent); override;
  128.   end;
  129.  
  130. var
  131.   MainForm: TMainForm;
  132.  
  133. const
  134.   MONTHS: Integer = 4;
  135.   ROWS: Integer = 3;
  136.  
  137. implementation
  138.  
  139. uses About;
  140.  
  141. {$R *.DFM}
  142.  
  143. constructor TMainForm.Create (AOwner: TComponent);
  144. begin
  145.   inherited Create (AOwner);
  146.  
  147.   HolidaysTable.Active:= true;
  148.   Year := StrToInt (YearEdit.Text);
  149. end;
  150.  
  151. procedure TMainForm.ExitActionExecute(Sender: TObject);
  152. begin
  153.   Close;
  154. end;
  155.  
  156. procedure TMainForm.AboutActionExecute(Sender: TObject);
  157. begin
  158.   AboutBox.ShowModal;
  159. end;
  160.  
  161. procedure TMainForm.PrintSetupActionExecute(Sender: TObject);
  162. begin
  163.   Report.PrinterSetup;
  164. end;
  165.  
  166. procedure TMainForm.PrintActionExecute(Sender: TObject);  
  167. begin
  168.   if Report.PrintSetup then Report.Print;
  169. end;
  170.  
  171. procedure TMainForm.PrintPreviewActionExecute(Sender: TObject);
  172. begin
  173.   Report.PrintPreview (PrintPreview);
  174. end;
  175.  
  176. procedure TMainForm.LoadActionExecute(Sender: TObject);
  177. begin
  178.   if LoadDialog.Execute then
  179.     (PictureLabel.Data as TAbsPicture).Picture.LoadFromFile (LoadDialog.FileName);
  180. end;
  181.  
  182. procedure TMainForm.Zoom25ActionExecute(Sender: TObject);
  183. begin
  184.   VRPage1.Zoom := 25;
  185. end;
  186.  
  187. procedure TMainForm.Zoom50ActionExecute(Sender: TObject);
  188. begin
  189.   VRPage1.Zoom := 50;
  190. end;
  191.  
  192. procedure TMainForm.Zoom100ActionExecute(Sender: TObject);
  193. begin
  194.   VRPage1.Zoom := 100;
  195. end;
  196.  
  197. procedure TMainForm.Zoom200ActionExecute(Sender: TObject);
  198. begin
  199.   VRPage1.Zoom := 200;
  200. end;
  201.  
  202. procedure TMainForm.Zoom400ActionExecute(Sender: TObject);
  203. begin
  204.   VRPage1.Zoom := 400;
  205. end;
  206.  
  207. procedure TMainForm.YearEditExit(Sender: TObject);
  208. begin
  209.   Year := StrToInt (YearEdit.Text);
  210.   VRPage1.Invalidate;
  211. end;
  212.  
  213. procedure TMainForm.YearEditKeyPress(Sender: TObject; var Key: Char);
  214. begin
  215.   if Integer (Key) = VK_RETURN then YearEditExit(Sender);
  216. end;
  217.  
  218. procedure TMainForm.TextEditChange(Sender: TObject);
  219. begin
  220.   (TextLabel.Data as TAbsPlainText).StringList.Text := TextEdit.Lines.Text;
  221. end;
  222.  
  223. procedure TMainForm.YearLabelCalcValue(Sender: TObject);
  224. begin
  225.   (YearLabel.Data as TAbsString).Value := IntToStr (Year);
  226. end;
  227.  
  228. procedure TMainForm.ShadowLabelCalcValue(Sender: TObject);
  229. begin
  230.   (ShadowLabel.Data as TAbsString).Value := IntToStr (Year);
  231. end;
  232.  
  233. procedure TMainForm.HolidaysTableDateGetText(Sender: TField; var Text: String; DisplayText: Boolean);
  234. var 
  235.   Year, Month, Day: Word;
  236. begin
  237.   if DisplayText then Text := FormatDateTime ('d mmmm',Sender.AsDateTime)
  238.   else
  239.   begin
  240.     DecodeDate (Sender.AsDateTime,Year,Month,Day);
  241.     Text := IntToStr (Day) + '.' + IntToStr (Month);
  242.   end;
  243. end;
  244.  
  245. procedure TMainForm.HolidaysTableDateSetText(Sender: TField; const Text: String);
  246. var
  247.   Month, Day: Integer;
  248.   APos: Integer;
  249. begin
  250.   APos := Pos ('.',Text);
  251.  
  252.   if APos <> 0 then
  253.   begin
  254.     Day := StrToInt (Copy (Text,1,APos-1));
  255.     Month := StrToInt (Copy (Text,APos+1,Length(Text)-APos));
  256.     Sender.AsDateTime := EncodeDate (2000,Month,Day);
  257.   end 
  258.   else raise EConvertError.Create ('Invalid date string');
  259. end;
  260.  
  261. procedure TMainForm.HolidaysTableAfterPost(DataSet: TDataSet);
  262. begin
  263.   VRPage1.Invalidate;
  264. end;
  265.  
  266. procedure TMainForm.MonthsGridCells0CalcValue(Sender: TObject);
  267. begin
  268.   (Sender as TAbsString).Value := LowerCase (LongMonthNames[MonthsCol + (Row*MONTHS) + 1]);
  269. end;
  270.  
  271. procedure TMainForm.MonthsGridCells1CalcValue(Sender: TObject);
  272. var
  273.   Index: Integer;
  274. begin
  275.   if WeekDay = 6 then Index := 1
  276.   else Index := WeekDay + 2;
  277.  
  278.   (Sender as TAbsString).Value := UpperCase (ShortDayNames[Index]);
  279.  
  280.   if WeekDay > 4 then (Sender as TAbsString).Font.Color := clRed
  281.   else (Sender as TAbsString).Font.Color := clGray;
  282. end;
  283.  
  284. procedure TMainForm.MonthsGridCells2CalcValue(Sender: TObject);
  285. var
  286.   FirstDayDate: TDateTime;
  287.   Day: Integer;
  288. begin
  289.   FirstDayDate := EncodeDate (Year,MonthsCol + (Row*MONTHS) + 1,1);
  290.   Day := Max ((Week*7) + WeekDay - ((DayOfWeek (FirstDayDate)+5) mod 7) + 1,0);
  291.  
  292.   if Variant (Day) > Variant(IncMonth (FirstDayDate,1) - FirstDayDate) then Day := 0;
  293.  
  294.   (Sender as TAbsInt).Value := Day;
  295.  
  296.   if (WeekDay > 4) or ((Day <> 0) and (not VarIsNull (HolidaysTable.Lookup ('Date',EncodeDate (2000,MonthsCol + (Row*MONTHS) + 1,Day),'Date')))) then
  297.     (Sender as TAbsInt).Font.Color := clRed
  298.   else
  299.     (Sender as TAbsInt).Font.Color := clBlack;
  300. end;
  301.  
  302. procedure TMainForm.MonthsGridColumns0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  303. begin
  304.   Inc (MonthsCol);
  305.  
  306.   if MonthsCol < MONTHS then ARepeat := aaRepeat
  307.   else MonthsCol := 0;
  308. end;
  309.  
  310. procedure TMainForm.MonthsGridRows0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  311. begin
  312.   Inc (Row);
  313.  
  314.   if Row < ROWS then ARepeat := aaRepeat
  315.   else Row := 0;
  316. end;
  317.  
  318. procedure TMainForm.MonthsGridColumns0SubItems0EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  319. begin
  320.   Inc (WeekDay);
  321.  
  322.   if WeekDay < 7 then ARepeat := aaRepeat
  323.   else WeekDay := 0;
  324. end;
  325.  
  326. procedure TMainForm.MonthsGridRows0SubItems2EndPrint(Sender: TObject; var ARepeat: TAfterAction);
  327. begin
  328.   Inc (Week);
  329.  
  330.   if Week < 6 then ARepeat := aaRepeat
  331.   else Week := 0;
  332. end;
  333.  
  334. procedure TMainForm.MonthsGridColumns0SubItems1BeginPrint(Sender: TObject; var APrint: TBeforeAction);
  335. begin
  336.   if MonthsCol = (MONTHS - 1) then APrint := baNoPrint;
  337. end;
  338.  
  339. end.
  340.