CalLite: Flag days in Finland/fi
From Free Pascal wiki
Jump to navigationJump to searchThe printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
│
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.