CalLite: Flag days in Finland/fi
From Lazarus wiki
Jump to navigationJump to search
│
English (en) │
suomi (fi) │
Liputuspäivät Suomessa
TCalendarLite on Kalenterikomponentti. Tämä demo näyttää kuinka CalLite komponenttiin voidaan lisätä Suomen liputuspäivat pienillä kuvakkeilla.
unit uFinlandFlagDays
unit uFinlandFlagDays;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CalendarLite, DateUtils;
procedure CalendarGetFlagDaysInFinland( AMonth, AYear: Integer;
var Holidays: THolidays);
implementation
const
SATURDAY = 6;
SUNDAY = 7;
FEBRUARY = 2;
MARCH = 3;
APRIL = 4;
MAY = 5;
JUNE = 6;
JULY = 7;
OCTOBER = 10;
NOVEMBER = 11;
DECEMBER = 12;
function MothersDay(year:integer):integer; //Äitienpäivä
var
day : integer;
a_date : TDateTime;
begin
day := 7;
repeat
inc(day);
a_date := EncodeDate(year, MAY, day);
until DayOfTheWeek( a_date ) = SUNDAY;
result := day;
end;
function FathersDay(year:integer):integer; // Isänpäivä
var
day : integer;
a_date : TDateTime;
begin
day := 7;
repeat
inc(day);
a_date := EncodeDate(year, NOVEMBER, day);
until DayOfTheWeek( a_date ) = SUNDAY;
result := day;
end;
function MidsummerDay(year:integer):integer; // Juhannus
var
day : integer;
a_date : TDateTime;
begin
day := 20-1;
repeat
inc(day);
a_date := EncodeDate(year, JUNE, day);
until DayOfTheWeek( a_date ) = SATURDAY;
result := day;
end;
function MemorialDayWarDead(year:integer):integer; //Kaatuneiden muistopäivä
var
day : integer;
a_date : TDateTime;
begin
day := MothersDay(year);
repeat
inc(day);
a_date := EncodeDate(year, MAY, day);
until DayOfTheWeek( a_date ) = SUNDAY;
result := day;
end;
procedure CalendarGetFlagDaysInFinland( AMonth, AYear: Integer;
var Holidays: THolidays);
begin
ClearHolidays(Holidays);
begin
case AMonth of
FEBRUARY: begin
AddHoliday( 5, Holidays);// J. L. Runebergin päivä
AddHoliday(28, Holidays);// Kalevalan päivä
end;
MARCH: AddHoliday(19, Holidays);// Tasa-arvon päivä, Minna Canthin päivä
APRIL: begin
AddHoliday( 9, Holidays);// Suomen kielen päivä, Mikael Agricolan
// ja Elias Lönnrotin päivä
AddHoliday(27, Holidays);// Kansallinen veteraanipäivä
end;
MAY: begin
AddHoliday( 1, Holidays);// Suomalaisen työn päivä, vappu
AddHoliday( 9, Holidays);// Eurooppa-päivä
AddHoliday(12, Holidays);// Suomalaisuuden päivä, J. V. Snellmanin päivä
AddHoliday(MothersDay(AYear), Holidays); // Äitienpäivä
AddHoliday(MemorialDayWarDead(AYear), Holidays);//Kaatuneiden
//muistopäivä
end;
JUNE: begin
AddHoliday( 4, Holidays);// Puolustusvoimain lippujuhlan päivä
// Gustaf Mannerheimin päivä
AddHoliday(MidsummerDay(AYear), Holidays);// Suomen lipun päivä
// Juhannuspäivä
end;
JULY: AddHoliday( 6, Holidays);// Runon ja suven päivä,
// Eino Leinon päivä
OCTOBER: begin
AddHoliday(10, Holidays);// Suomalaisen kirjallisuuden päivä
// Aleksis Kiven päivä
AddHoliday(24, Holidays);// Yhdistyneiden kansakuntien päivä
end;
NOVEMBER: begin
AddHoliday( 6, Holidays);// Ruotsalaisuuden päivä,
// Kustaa Aadolfin päivä
AddHoliday(FathersDay(AYear), Holidays);//Isänpäivä
end;
DECEMBER: begin
AddHoliday( 6, Holidays);// Itsenäisyyspäivä
AddHoliday( 8, Holidays);// Suomalaisen musiikin päivä,
// Jean Sibeliuksen päivä
end;
end;
end;
end;
end.
unit unitFinlandFlagDays
unit unitFinlandFlagDays;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, CalendarLite,
Types, lcltype, uFinlandFlagDays;
type
{ TForm1 }
TForm1 = class(TForm)
CalendarLite1: TCalendarLite;
procedure CalendarLite1DrawCell(Sender: TObject; ACanvas: TCanvas; AYear,
AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
var AContinueDrawing: Boolean);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
procedure FlagOfFinland(var Bitmap: TBitmap); // Suomen lippu
const
FFH = 11; // FinlandFlagHeight
FFCH1 = 4; // FinlandFlagCrossH1
FFCH2 = 7; // FinlandFlagCrossH2
FFW = 18; // FinlandFlagWidth
FFCW1 = 5; // FinlandFlagCrossW1
FFCW2 = 8; // FinlandFlagCrossW2
begin
Bitmap.Canvas.Pen.Color := clWhite;
Bitmap.Canvas.Brush.Style:=bsSolid;
Bitmap.Canvas.Brush.Color:= clWhite;
Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
Bitmap.Canvas.Brush.Color:=RGBToColor(0, 47, 108) ;
Bitmap.Canvas.FillRect(0,MulDiv(Bitmap.Height,FFCH1,FFH),
Bitmap.Width,MulDiv(Bitmap.Height,FFCH2,FFH));
Bitmap.Canvas.FillRect(MulDiv(Bitmap.Width,FFCW1,FFW),
0,MulDiv(Bitmap.Width,FFCW2,FFW),Bitmap.Height);
end;
{$R *.lfm}
{ TForm1 }
procedure TForm1.CalendarLite1DrawCell(Sender: TObject; ACanvas: TCanvas;
AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
var AContinueDrawing: Boolean);
var
Bitmap: TBitmap;
Flagdays: THolidays;
begin
CalendarGetFlagDaysInFinland(AMonth,AYear,Flagdays);
if IsHoliday(aDay,Flagdays) and not (csOtherMonth in AState) then begin
Bitmap := TBitmap.Create;
try
// Initializes the Bitmap Size
Bitmap.Height := 11;
Bitmap.Width := 18;
FlagOfFinland(Bitmap); // Suomen lipun piirto
ACanvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - Bitmap.Height) div 2,
Bitmap);
inc(ARect.Left, Bitmap.Width + 2);
// Not changing AContinueDrawing from its default value (true) means
// that the day text is drawn by the built-in procedure into
// the reduced rectangle
finally
Bitmap.Free;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CalendarLite1.Languages := lgFinnish;
CalendarLite1.StartingDayOfWeek := dowMonday;
CalendarLite1.Date:=now;
end;
end.
unitFinlandFlagDays.lfm
object Form1: TForm1
Left = 543
Height = 278
Top = 159
Width = 426
Caption = 'Flag days in Finland'
ClientHeight = 278
ClientWidth = 426
OnCreate = FormCreate
LCLVersion = '1.8.0.5'
object CalendarLite1: TCalendarLite
Left = 72
Height = 200
Top = 56
Width = 274
Constraints.MinHeight = 120
Constraints.MinWidth = 120
ParentColor = False
TabOrder = 0
TabStop = True
Colors.TodayFrameColor = clGray
Date = 42993
DayNames = 'Su,Ma,Ti,ke,To,Pe,La'
DisplayTexts = '"Tänään on",dd.mm.yyyy,Lomapäivät,"Lomapäiviä ei ole asetettu"'
MonthNames = 'Tammikuu,Helmikuu,Maaliskuu,Huhtikuu,Toukokuu,Kesäkuu,Heinäkuu,Elokuu,Syyskuu,Lokakuu,Marraskuu,Joulukuu'
MultiSelect = False
StartingDayOfWeek = dowMonday
WeekendDays = [dowSunday, dowSaturday]
Languages = lgFinnish
OnDrawCell = CalendarLite1DrawCell
end
end
program flagdays_project
program flagdays_project;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, unitFinlandFlagDays, uFinlandFlagDays
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.