Печать календаря.

[romantik1993]

Подскажите, может у кого то уже готовый есть или как реализовать. Мне нужно задать на форме любой год, и по нажатию на кнопку нужно что бы на печать выводился календарь на год по месяцам более менее визуально воспринимаемый

[min@y™]

А нафига вообще что-то кодить? Ёксцель жэж есть, ёмаё!

[newerow1989]

Вот код, рисующий месяц:

type
  tOrient = (horz,vert);

***

procedure MesRis(Canvas:tCanvas;x,y,mes,god:integer;d31:boolean;orient:tOrient);
var i,x1,x2,y1,y2,nomer_dn,PosX,PosY,dx,dy{размер клетки}:integer;
    dat:TDateTime;
begin
   dx:=25;
   dy:=20;
   If orient=vert then
      dy:=19;
   With Canvas do
   begin
      Font.Size:=11;
      Font.Color:=1;
      TextOut(x+55,y+2,mesyatsR[mes]);
      Pen.Width:=2;
      Pen.Color:=1;
      Brush.Color:=clYellow;
      x1:=x+1;
      y1:=y+dy+1;
      x2:=x+7*dx+1;
      y2:=y+2*dy+1;
      If orient=vert then
      begin
         x2:=x+dx+1;
         y2:=y+8*dy+1;
      end;
      Rectangle(x1,y1,x2,y2);
      Font.Color:=clNavy;
      For i:=0 to 7 do
         If i<7 then
         begin
            x1:=x+i*dx;
            y1:=y+dy;
            If orient=vert then
            begin
               x1:=x;
               y1:=y+(i+1)*dy;
            end;
            TextOut(x1+4,y1+2,dnR[((i+1) mod 7)+1]);
         end;
      PosX:=1;
      PosY:=2;
      Pen.Width:=1;
      Font.Color:=1;
      For i:=1 to 31 do
         If TryEncodeDate(god,mes,i,dat) then
         begin
            nomer_dn:=DayOfWeek(dat);
            nomer_dn:=nomer_dn-1;
            If nomer_dn=0 then
               nomer_dn:=7;
            If (nomer_dn=1) and (i>1) then
            begin
               PosX:=PosX+1;
               PosY:=PosY+1;
            end;
            If (PosX=6) and d31 {перенести "31" в первый (левый) ряд} then
               PosX:=1;
            If (PosY=7) and d31 {перенести "31" в первый (верхний) ряд} then
               PosY:=2;
            Brush.Color:=Form1.Color;
            x1:=x+(nomer_dn-1)*dx;
            y1:=y+PosY*dy;
            x2:=x+nomer_dn*dx+1;
            y2:=y+(PosY+1)*dy+1;
            If orient=vert then
            begin
               x1:=x+PosX*dx;
               y1:=y+nomer_dn*dy;
               x2:=x+(PosX+1)*dx+1;
               y2:=y+(nomer_dn+1)*dy+1;
            end;
            Rectangle(x1,y1,x2,y2);
            TextOut(x1+5,y1+2,IntToStr(i));
            Brush.Color:=Form1.Color;
         end;
      PosX:=PosX+1;
      If d31 then
         PosX:=6;
      PosY:=PosY+1;
      If d31 then
         PosY:=7;
      Pen.Width:=2;
      MoveTo(x,y+1);
      x2:=x+7*dx;
      If orient=vert then
         x2:=x+PosX*dx;
      LineTo(x2,y+1);//верхняя линия
      If orient=vert then
      begin
         MoveTo(x,y+dy+1);
         LineTo(x+PosX*dx,y+dy+1);//2-я верхняя линия
      end;
      y1:=y+PosY*dy+1;
      x2:=x+7*dx;
      If orient=vert then
      begin
         y1:=y+8*dy;
         x2:=x+PosX*dx;
      end;
      MoveTo(x,y1);
      LineTo(x2,y1);//нижняя линия
      y2:=y+PosY*dy;
      If orient=vert then
         y2:=y+8*dy;
      MoveTo(x+1,y);
      LineTo(x+1,y2);//левая линия
      x1:=x+7*dx;
      y2:=y+PosY*dy;
      If orient=vert then
      begin
         x1:=x+PosX*dx;
         y2:=y+8*dy;
      end;
      MoveTo(x1,y);
      LineTo(x1,y2);//правая линия
      Pen.Width:=1;
      If orient=horz then
         For i:=1 to 6 do
         begin
            MoveTo(x+i*dx,y+dy+1);
            LineTo(x+i*dx,y+PosY*dy+1);
         end else
         For i:=2 to 7 do
         begin
            MoveTo(x,y+i*dy);
            LineTo(x+PosX*dx+1,y+i*dy);
         end;//сетка
   end;
end;

***

MesRis(Image1.Canvas,20,20,3,2016,true,vert);

Программа

[min@y™]

Вот код, рисующий месяц

ты прикалываешься, да?
ну не поверю, что ты это серьёзно.

[newerow1989]

ты прикалываешься, да?
ну не поверю, что ты это серьёзно.

Я имел ввиду такой месяц:
Безымянный.png
А ты что подумал?

А чтобы календарь составить нужно по циклу пробежаться:

   x:=0;
   y:=0;
   For i:=1 to 12 do
   begin
      MesRis(Image1.Canvas,x,y,i,2016,true,horz);
      x:=x+8*24;
      If i mod 4=0 then
      begin
         x:=0;
         y:=y+8*20;
      end;
   end;

[min@y™]

Я имел ввиду такой месяц:
А ты что подумал?

Я понял, что за месяц.
Просто я икать начал, когда полотенце кода увидел.

[kropotkina-alice]

"Рыба" для печати календаря:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Spin, Menus, Graphics, StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem; //"Исходные данные"
    GroupBox1: TGroupBox; //в нем -> SpinEdit1 и Button1
    SpinEdit1: TSpinEdit; //MinValue=2000 & MaxValue=2100
    Button1: TButton; //"Создать"
    N2: TMenuItem; //"Создать календарь"
    N3: TMenuItem; //"Вывести на печать"
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  year: integer;
  months: array [1..12] of integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const // Настройки размеров календаря:
  MonthDX = 150;
  MonthDY = 135;
  DayDX = 20;
  DayDY = 15;
  MonthH = 20;
var
  month, i: integer;
  day: integer;
  s: string[2];
begin
  GroupBox1.Visible:=False;
  with Form1.Canvas do for month := 1 to 12 do
  begin
    // Вывод названия месяца:
    Font.Name := 'Arial';
    Font.Size := 13;
    Font.Style:=Font.Style+[fsBold];
    TextOut((month - 1) mod 3 * MonthDX, (month - 1) div 3 * MonthDY,
      LongMonthNames[month]);
    Font.Name := 'Courier';
    Font.Size := 8;
    Font.Style:=Font.Style-[fsBold];
    // Вывод названий дней недели:
    for day := 1 to 7 do
      TextOut((month - 1) mod 3 * MonthDX,
        day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH,
        ShortDayNames[(day + 1) mod 7 + 1]);
    // Определение дня недели первого числа месяца:
    day := DayOfWeek(EncodeDate(year, month, 1)) - 2;
    if day < 0 then inc(day, 7);
    // Вывод чисел:
    for i := 1 to months[month] do begin
      str(i: 2, s);
      TextOut(day div 7 * DayDX + (month - 1) mod 3 * MonthDX + DayDX,
        day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH, s);
      inc(day);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
year:=2000;
  Form1.Caption := 'Календарь на ' + IntToStr(year) + ' год';
  Form1.Color := clWhite;
  // Длины месяцев:
  months[1] := 31;
  months[2] := 28 + ord(IsLeapYear(year));
  months[3] := 31;
  months[4] := 30;
  months[5] := 31;
  months[6] := 30;
  months[7] := 31;
  months[8] := 31;
  months[9] := 30;
  months[10] := 31;
  months[11] := 30;
  months[12] := 31;
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
year:=SpinEdit1.Value;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
GroupBox1.Visible:=True;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Button1Click(Self);
Form1.Print;
end;

end.

[Smitt&Wesson]

Сообщение от min@y™

Просто я икать начал, когда полотенце кода увидел.

. Приколисты!