paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-24 00:27:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

Added Calendar component

Browse Source 
Shane

git-svn-id: trunk@480 -
This commit is contained in:
lazarus 2001-12-05 17:23:45 +00:00
parent f1b9d4e965
commit 9585b83378
9 changed files with 313 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -176,6 +176,7 @@ images/components/tbitbtn.ico -text svneol=unset#image/x-icon
images/components/tbitbtn.xpm -text svneol=native#image/x-xpixmap
images/components/tbutton.ico -text svneol=unset#image/x-icon
images/components/tbutton.xpm -text svneol=native#image/x-xpixmap
images/components/tcalendar.xpm -text svneol=native#image/x-xpixmap
images/components/tcheckbox.ico -text svneol=unset#image/x-icon
images/components/tcheckbox.xpm -text svneol=native#image/x-xpixmap
images/components/tcolordialog.ico -text svneol=unset#image/x-icon
@ -301,6 +302,7 @@ images/uparrow.ico -text svneol=unset#image/x-icon
images/uparrow.xpm -text svneol=native#image/x-xpixmap
lcl/allunits.pp svneol=native#text/pascal
lcl/buttons.pp svneol=native#text/pascal
lcl/calendar.pp svneol=native#text/pascal
lcl/clipbrd.pp svneol=native#text/pascal
lcl/clistbox.pp svneol=native#text/pascal
lcl/comctrls.pp svneol=native#text/pascal

5
ide/idecomp.pp
View File

@ -30,7 +30,7 @@ interface
uses
Classes, LclLinux, StdCtrls, Forms, Buttons, Menus, ComCtrls,
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs,Calendar
{$IFDEF DATABASE}
,db
@ -306,6 +306,9 @@ begin
,TBevel,TRadioGroup]);
RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView
,TProgressBar,TToolBar,TTrackbar]);
RegisterComponents('Misc','Calendar',[TCalendar]);
RegisterComponents('System','ExtCtrls',[TTimer]);
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog
,TColorDialog,TFontDialog]);

75
images/components/tcalendar.xpm Normal file
View File

@ -0,0 +1,75 @@
/* XPM */
static char *tcalendar[]={
"20 19 53 1",
"k c #000000",
"A c #000004",
"a c #000005",
"M c #000007",
"X c #000009",
"N c #00000b",
"R c #00000c",
"Y c #00000e",
"P c #00000f",
"T c #000014",
"# c #000100",
"Q c #00020f",
"u c #010101",
"b c #020005",
"z c #030207",
"S c #040519",
"L c #05040c",
"s c #050503",
"f c #060405",
"U c #060513",
"O c #070614",
"W c #070705",
"V c #070904",
". c #ab172f",
"h c #eef0ff",
"E c #f2f1ff",
"o c #f2f4ff",
"B c #f3f3ff",
"n c #f3f5ff",
"m c #f3f6ff",
"p c #f4f6ff",
"v c #f5f7ff",
"w c #f5f9ff",
"e c #f6f5fd",
"t c #f6f8ff",
"x c #f7f4ff",
"C c #f7f6ff",
"r c #f7f7ff",
"y c #f8f1ff",
"q c #f8f5ff",
"D c #f8f8ff",
"l c #f8fcff",
"i c #f9f7ff",
"g c #f9f8ff",
"K c #fbf9ff",
"F c #fbfbff",
"d c #fcf9ff",
"G c #fcfeff",
"j c #fcffff",
"I c #fdfdff",
"J c #fefeff",
"H c #fefffa",
"c c #fffdff",
"....................",
"#..#..#..#..#..#...a",
"#..#..#..#..#..#...b",
"####################",
"#cd#ee#ce#ee#ee#eeef",
"#g.#h.#c.#i.#j.#e..k",
"####################",
"#lm#no#po#qr#ee#eees",
"#t.#e.#e.#e.#e.#c..u",
"####################",
"#ee#vw#xy#ee#ee#eeez",
"#e.#e.#e.#e.#e.#e..A",
"####################",
"#BC#nD#Eg#iF#ce#eeek",
"#G.#c.#c.#e.#c.#H..s",
"####################",
"#Ie#ee#ce#..#..#...A",
"#J.#e.#K.#..#..#...L",
"#MNOPQNRSTUM#V#WXYYX"};

25
images/components_images.lrs
View File

@ -61,6 +61,31 @@
+'",'#10'"+&*=-&;*]8<^90)&;!~",'#10'"abcdefghhhhhhhhijk~",'#10'"~2~|~(~~~~'
+'~~~~~~2~4"};'#10
);
LazarusResources.Add('tcalendar','XPM',
'/* XPM */'#10'static char *tcalendar[]={'#10'"20 19 53 1",'#10'"k c #0000'
+'00",'#10'"A c #000004",'#10'"a c #000005",'#10'"M c #000007",'#10'"X c #'
+'000009",'#10'"N c #00000b",'#10'"R c #00000c",'#10'"Y c #00000e",'#10'"P'
+' c #00000f",'#10'"T c #000014",'#10'"# c #000100",'#10'"Q c #00020f",'#10
+'"u c #010101",'#10'"b c #020005",'#10'"z c #030207",'#10'"S c #040519",'
+#10'"L c #05040c",'#10'"s c #050503",'#10'"f c #060405",'#10'"U c #060513'
+'",'#10'"O c #070614",'#10'"W c #070705",'#10'"V c #070904",'#10'". c #ab'
+'172f",'#10'"h c #eef0ff",'#10'"E c #f2f1ff",'#10'"o c #f2f4ff",'#10'"B c'
+' #f3f3ff",'#10'"n c #f3f5ff",'#10'"m c #f3f6ff",'#10'"p c #f4f6ff",'#10
+'"v c #f5f7ff",'#10'"w c #f5f9ff",'#10'"e c #f6f5fd",'#10'"t c #f6f8ff",'
+#10'"x c #f7f4ff",'#10'"C c #f7f6ff",'#10'"r c #f7f7ff",'#10'"y c #f8f1ff'
+'",'#10'"q c #f8f5ff",'#10'"D c #f8f8ff",'#10'"l c #f8fcff",'#10'"i c #f9'
+'f7ff",'#10'"g c #f9f8ff",'#10'"K c #fbf9ff",'#10'"F c #fbfbff",'#10'"d c'
+' #fcf9ff",'#10'"G c #fcfeff",'#10'"j c #fcffff",'#10'"I c #fdfdff",'#10
+'"J c #fefeff",'#10'"H c #fefffa",'#10'"c c #fffdff",'#10'"..............'
+'......",'#10'"#..#..#..#..#..#...a",'#10'"#..#..#..#..#..#...b",'#10'"##'
+'##################",'#10'"#cd#ee#ce#ee#ee#eeef",'#10'"#g.#h.#c.#i.#j.#e.'
+'.k",'#10'"####################",'#10'"#lm#no#po#qr#ee#eees",'#10'"#t.#e.'
+'#e.#e.#e.#c..u",'#10'"####################",'#10'"#ee#vw#xy#ee#ee#eeez",'
+#10'"#e.#e.#e.#e.#e.#e..A",'#10'"####################",'#10'"#BC#nD#Eg#iF'
+'#ce#eeek",'#10'"#G.#c.#c.#e.#c.#H..s",'#10'"####################",'#10'"'
+'#Ie#ee#ce#..#..#...A",'#10'"#J.#e.#K.#..#..#...L",'#10'"#MNOPQNRSTUM#V#W'
+'XYYX"};'#10
);
LazarusResources.Add('tcheckbox','XPM',
'/* XPM */'#10'static char * tcheckbox_xpm[] = {'#10'"13 13 40 1",'#10'" '
+#9'c None",'#10'".'#9'c #727272",'#10'"+'#9'c #7D7D7D",'#10'"@'#9'c #0505'

139
lcl/calendar.pp Normal file
View File

@ -0,0 +1,139 @@
{
/***************************************************************************
Calendar.pp
-------------------
Component Library Calendar Component
Initial Revision : Wed Dec 05 2001
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
}
{
@abstract(Calendar component)
@author(Shane Miller)
@created(05 Dev 2001)
}
unit calendar;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Controls, vclGlobals, lMessages;
Type
TDisplaySetting = (dsShowHeadings, dsShowDayNames, dsNoMonthChange, dsShowWeekNumbers,dsStartMonday);
TDisplaySettings = set of TDisplaySetting;
TLMCalendar = record
Date : TDateTime;
DisplaySettings : TDisplaySettings;
end;
TCalendar = class(TCustomControl)
private
FDate : String;
FDisplaySettings : TDisplaySettings;
Procedure GetProps;
Procedure SetProps( aDate: String; aDisplaySettings : TDisplaySettings);
function GetDisplaySettings: TDisplaySettings;
procedure SetDisplaySettings(const AValue: TDisplaySettings);
function GetDate: String;
procedure SetDate(const AValue: String);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
Property Date : String read GetDate write SetDate;
property DisplaySettings : TDisplaySettings read GetDisplaySettings write SetDisplaySettings;
// Property Date : TDate read GetDate write SetDate;
property Visible;
end;
implementation
{ TCalendar }
constructor TCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{create the control}
fCompStyle := csCalendar;
setbounds(0,0,250,150);
fDisplaySettings := [dsShowHeadings, dsShowDayNames];
Date := FormatDateTime('dd-mm-yyyy',Now);
end;
destructor TCalendar.Destroy;
begin
Inherited;
end;
function TCalendar.GetDate: String;
begin
Result := '';
GetPRops;
Result := FDate;
end;
procedure TCalendar.SetDate(const AValue: String);
var
Temp : TDateTime;
begin
SetProps(AValue,FDisplaySettings);
end;
function TCalendar.GetDisplaySettings: TDisplaySettings;
begin
Result := FDisplaySettings;
end;
procedure TCalendar.SetDisplaySettings(const AValue: TDisplaySettings);
begin
FDisplaySettings := AValue;
SetProps(FDate,FDisplaySettings);
end;
Procedure TCalendar.GetProps;
var
Temp : TLMCalendar;
begin
if HandleAllocated then
begin
CNSendMessage(LM_GETVALUE, Self, @temp); // Get the info
FDate := FormatDateTime('dd-mm-yyyy',Temp.Date);
end;
end;
Procedure TCalendar.SetProps( aDate: String; aDisplaySettings : TDisplaySettings);
var
Temp : TLMCalendar;
begin
if HandleAllocated then
begin
Temp.Date := StrtoDate(aDate);
Temp.DisplaySettings := aDisplaySettings;
CNSendMessage(LM_SETVALUE, Self, @temp); // Get the info
End;
end;
end.

7
lcl/controls.pp
View File

@ -178,6 +178,9 @@ const
type
TWinControl = class;
TControl = class;
TDate = type TDateTime;
TTime = type TDateTime;
TCMMouseWheel = record
MSg: Cardinal;
@ -1144,6 +1147,10 @@ end.
{ =============================================================================
$Log$
Revision 1.26 2001/12/05 17:23:44 lazarus
Added Calendar component
Shane
Revision 1.25 2001/11/10 10:48:00 lazarus
MG: fixed set formicon on invisible forms

6
lcl/interfaces/gtk/gtkint.pp
View File

@ -32,7 +32,7 @@ interface
uses
InterfaceBase, gtk, gdk, glib, SysUtils, LMessages, Classes, Controls,
ExtCtrls, Forms, Dialogs, VclGlobals, StdCtrls, ComCtrls, LCLLinux, gtkdef,
DynHashArray, LazQueue;
DynHashArray, LazQueue,Calendar;
type
TgtkObject = class(TInterfaceBase)
@ -324,6 +324,10 @@ end.
{ =============================================================================
$Log$
Revision 1.24 2001/12/05 17:23:45 lazarus
Added Calendar component
Shane
Revision 1.23 2001/11/13 18:50:10 lazarus
Changes to facilitate the toggle between form and unit
Shane

54
lcl/interfaces/gtk/gtkobject.inc
View File

@ -1966,6 +1966,12 @@ begin
p := gtk_button_new_with_label(StrTemp);
end;
csCalendar :
begin
p := gtk_calendar_new();
end;
csCheckbox :
begin
p := gtk_check_button_new_with_label(strTemp);
@ -2711,6 +2717,7 @@ end;
function TgtkObject.GetValue (Sender : TObject; data : pointer) : integer;
var
Handle : Pointer;
Year,Month,Day : Integer; //used for csCalendar
begin
result := 0; // default if nobody sets it
@ -2734,6 +2741,14 @@ begin
csCheckbox : if gtk_toggle_button_get_active (PGtkToggleButton (handle))
then TCheckBoxState (data^) := cbChecked
else TCheckBoxState (data^) := cbUnChecked;
csCalendar :Begin
gtk_calendar_get_date(PgtkCalendar(handle),@Year, @Month, @Day);
//TODO: account for local settings like date format
//Form some reason, the month is zero based.
TLMCalendar(data^).Date := StrtoDate(Inttostr(Day)+'-'+Inttostr(Month+1)+'-'+Inttostr(Year));
end;
else
Assert (true, Format ('WARNING:[TgtkObject.GetValue] failed for %s', [Sender.ClassName]));
end;
@ -2755,6 +2770,11 @@ end;
function TgtkObject.SetValue (Sender : TObject; data : pointer) : integer;
var
Handle : Pointer;
//used for csCalendar
Date : TDateTime;
Year,Month,Day : String;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
NUm : Integer;
begin
result := 0; // default if nobody sets it
@ -2780,6 +2800,36 @@ begin
csCheckbox : if TCheckBoxState (data^) = cbChecked
then gtk_toggle_button_set_active( PGtkToggleButton (handle), TRUE)
else gtk_toggle_button_set_active( PGtkToggleButton (handle), FALSE);
csCalendar : Begin
Date := TLMCalendar(data^).Date;
Year := FormatDateTime('yyyy',Date);
Month := FormatDateTime('mm',Date);
Day := FormatDateTime('dd',Date);
gtk_calendar_select_month(PgtkCalendar(handle),StrtoInt(Month)-1,StrToInt(Year));
gtk_calendar_select_day(PgtkCalendar(handle),StrToInt(Day));
//set display options
Num := 0;
if (dsShowHeadings in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 0);
if (dsShowDayNames in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 1);
if (dsNoMonthChange in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 2);
if (dsShowWeekNumbers in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 3);
if (dsStartMonday in TLMCalendar(data^).DisplaySettings) then
num := Num + (1 shl 4);
gtkCalendarDisplayOptions := TgtkCalendarDisplayOPtions(num);
gtk_Calendar_Display_options(PgtkCalendar(handle),gtkCalendarDisplayOptions);
end;
else
Assert (true, Format ('WARNING:[TgtkObject.SetValue] failed for %s', [Sender.ClassName]));
end;
@ -3358,6 +3408,10 @@ end;
{ =============================================================================
$Log$
Revision 1.78 2001/12/05 17:23:45 lazarus
Added Calendar component
Shane
Revision 1.77 2001/11/26 14:19:34 lazarus
Added some code to make the interbae components work better.
Shane

2
lcl/vclglobals.pp
View File

@ -85,6 +85,8 @@ csCListBox = 45;
csSpeedButton = 46;
csPopupMenu = 47;
csHintWindow = 48;
csCalendar = 49;
type
//TODO: check this against lcllinux