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

Added TArrow component

Browse Source 
Shane

git-svn-id: trunk@486 -
This commit is contained in:
lazarus 2001-12-06 13:39:36 +00:00
parent 7838853d27
commit 8101dbe40c
10 changed files with 218 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -172,6 +172,7 @@ images/color.ico -text svneol=unset#image/x-icon
images/color.xpm -text svneol=native#image/x-xpixmap
images/components/default.ico -text svneol=unset#image/x-icon
images/components/default.xpm -text svneol=native#image/x-xpixmap
images/components/tarrow.xpm -text svneol=native#image/x-xpixmap
images/components/tbevel.ico -text svneol=unset#image/x-icon
images/components/tbevel.xpm -text svneol=native#image/x-xpixmap
images/components/tbitbtn.ico -text svneol=unset#image/x-icon
@ -303,6 +304,7 @@ images/sourceeditor/bookmark9.xpm -text svneol=native#image/x-xpixmap
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/arrow.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

3
ide/idecomp.pp
View File

@ -29,7 +29,7 @@ unit idecomp;
interface
uses
Classes, LclLinux, StdCtrls, Forms, Buttons, Menus, ComCtrls,
Classes, LclLinux, StdCtrls, Forms, Buttons, Menus, ComCtrls,Arrow,
Spin, SysUtils, Controls, CompReg, Graphics, ExtCtrls, Dialogs,Calendar
{$IFDEF DATABASE}
@ -308,6 +308,7 @@ begin
,TProgressBar,TToolBar,TTrackbar]);
RegisterComponents('Misc','Calendar',[TCalendar]);
RegisterComponents('Misc','Arrow',[TArrow]);
RegisterComponents('System','ExtCtrls',[TTimer]);
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog

21
images/components/tarrow.xpm Normal file
View File

@ -0,0 +1,21 @@
/* XPM */
static char *tarrow[]={
"16 16 2 1",
". c None",
"# c #000000",
"................",
".......##.......",
"......####......",
".....######.....",
"...##########...",
"..##........##..",
".###........###.",
"####........####",
"####........####",
".###........###.",
"..##........##..",
"...##########...",
".....######.....",
"......####......",
".......##.......",
"................"};

9
images/components_images.lrs
View File

@ -9,6 +9,15 @@
+','#10'"....%%....#**#&&#",'#10'" #*### ",'#10'" ###'
+' "};'#10
);
LazarusResources.Add('tarrow','XPM',
'/* XPM */'#10'static char *tarrow[]={'#10'"16 16 2 1",'#10'". c None",'#10
+'"# c #000000",'#10'"................",'#10'".......##.......",'#10'"....'
+'..####......",'#10'".....######.....",'#10'"...##########...",'#10'"..##'
+'........##..",'#10'".###........###.",'#10'"####........####",'#10'"####'
+'........####",'#10'".###........###.",'#10'"..##........##..",'#10'"...#'
+'#########...",'#10'".....######.....",'#10'"......####......",'#10'"....'
+'...##.......",'#10'"................"};'#10
);
LazarusResources.Add('tbevel','XPM',
'/* XPM */'#10'static char * tbevel_xpm[] = {'#10'"16 16 4 1",'#10'" '#9'c'
+' None",'#10'".'#9'c #FFFFFF",'#10'"+'#9'c #C0C0C0",'#10'"@'#9'c #808080"'

6
lcl/allunits.pp
View File

@ -14,7 +14,7 @@ uses
interfacebase, interfaces,
buttons, extctrls, registry, vclglobals, calendar,
clipbrd, filectrl, forms, lcllinux, spin,
comctrls, graphics, lmessages, stdctrls,
comctrls, graphics, lmessages, stdctrls, arrow,
controls, imglist, menus, toolwin,
dialogs, messages, utrace, dynhasharray,
clistbox, lazqueue;
@ -25,6 +25,10 @@ end.
{ =============================================================================
$Log$
Revision 1.10 2001/12/06 13:39:36 lazarus
Added TArrow component
Shane
Revision 1.9 2001/12/05 18:19:11 lazarus
MG: added calendar to allunits and removed unused vars

131
lcl/arrow.pp Normal file
View File

@ -0,0 +1,131 @@
{
/***************************************************************************
Arrow.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(Arrow component)
@author(Shane Miller)
@created(05 Dev 2001)
}
unit arrow;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Controls, vclGlobals, lMessages;
Type
TArrowType = (atUp, atDown, atLeft, atRight);
TShadowType = (stNone, stIn, stOut, stEtchedIn, stEtchedOut);
TLMArrow = record
ArrowType : TArrowType;
ShadowType : TShadowType;
end;
TArrow = class(TCustomControl)
private
FArrowType : TArrowType;
FShadowType : TShadowType;
FArrowChanged: TNotifyEvent;
function GetShadowType: TShadowType;
procedure SetShadowType(const AValue: TShadowType);
function GetArrowType: TArrowType;
procedure SetArrowType(const AValue: TArrowType);
procedure SetProps;
protected
procedure AttachSignals; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
Property ArrowType : TArrowType read GetArrowType write SetArrowType;
property ShadowType : TShadowType read fShadowType write SetShadowType;
property Visible;
property OnClick;
property OnMouseMove;
property OnMouseDown;
end;
implementation
{ TArrow }
procedure TArrow.AttachSignals;
begin
inherited;
end;
constructor TArrow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{create the control}
fCompStyle := csArrow;
setbounds(0,0,10,10);
fArrowType := atLeft;
fShadowType := stEtchedIn;
end;
destructor TArrow.Destroy;
begin
inherited;
end;
function TArrow.GetArrowType: TArrowType;
begin
Result := FArrowType;
end;
procedure TArrow.SetArrowType(const AValue: TArrowType);
begin
fArrowType := AValue;
SetProps;
end;
function TArrow.GetShadowType: TShadowType;
begin
Result := FShadowType;
end;
procedure TArrow.SetProps;
var
Temp : TLMArrow;
begin
if HandleAllocated then
begin
Temp.ArrowType := FArrowType;
Temp.ShadowType := FShadowType;
CNSendMessage(LM_SetValue,self,@Temp);
end;
end;
procedure TArrow.SetShadowType(const AValue: TShadowType);
begin
FShadowType := aValue;
SetProps;
end;
end.

6
lcl/calendar.pp
View File

@ -77,6 +77,9 @@ Type
property ReadOnly : Boolean read FReadOnly write SetReadOnly;
property Visible;
// property OnChange;
property OnClick;
property OnMouseMove;
property OnMouseDown;
property OnDayChanged : TNotifyEvent read FDayChanged write FDayChanged;
property OnMonthChanged : TNotifyEvent read FMonthChanged write FMonthChanged;
property OnYearChanged : TNotifyEvent read FYearChanged write FYearChanged;
@ -109,10 +112,9 @@ begin
end;
procedure TCalendar.SetDate(const AValue: String);
//var Temp : TDateTime;
begin
try
{Temp := }StrtoDate(AValue); //test to see if valid date....
StrtoDate(AValue); //test to see if valid date....
FDate := AValue;
SetProps;

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,Calendar;
DynHashArray, LazQueue,Calendar,Arrow;
type
TgtkObject = class(TInterfaceBase)
@ -324,6 +324,10 @@ end.
{ =============================================================================
$Log$
Revision 1.25 2001/12/06 13:39:36 lazarus
Added TArrow component
Shane
Revision 1.24 2001/12/05 17:23:45 lazarus
Added Calendar component
Shane

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

@ -1932,6 +1932,11 @@ begin
gtk_widget_show(p);
end;
csArrow :
begin
p := gtk_arrow_new(gtk_arrow_left,gtk_shadow_etched_in);
end;
csBitBtn :
begin
Assert(False, 'Trace:CSBITBTN CREATE*************************');
@ -2790,6 +2795,9 @@ var
Year,Month,Day : String;
gtkcalendardisplayoptions : TGtkCalendarDisplayOptions;
NUm : Integer;
ArrowType : TGTKArrowType;
ShadowType : TGTKShadowType;
begin
result := 0; // default if nobody sets it
@ -2851,6 +2859,31 @@ begin
gtk_calendar_thaw(PgtkCalendar(handle));
end;
csArrow : Begin
if TLmArrow(data^).ArrowType = atUp then
ArrowType := GTK_ARROW_UP
else
if TLMArrow(data^).ArrowType = atLeft then
ArrowType := GTK_ARROW_LEFT
else
if TLMArrow(data^).ArrowType = atRight then
ArrowType := GTK_ARROW_RIGHT
else
ArrowType := GTK_ARROW_DOWN;
case TLMArrow(data^).ShadowType of
stNONE : ShadowType := GTK_SHADOW_NONE;
stIN : ShadowType := GTK_SHADOW_IN;
stOut : ShadowType := GTK_SHADOW_OUT;
stEtchedIn : ShadowType := GTK_SHADOW_ETCHED_IN;
stEtchedOut : ShadowType := GTK_SHADOW_ETCHED_OUT;
else
ShadowType := GTK_SHADOW_NONE;
end;
gtk_arrow_set(PgtkArrow(handle),ArrowType,ShadowType);
end
else
Assert (true, Format ('WARNING:[TgtkObject.SetValue] failed for %s', [Sender.ClassName]));
@ -3430,6 +3463,10 @@ end;
{ =============================================================================
$Log$
Revision 1.81 2001/12/06 13:39:36 lazarus
Added TArrow component
Shane
Revision 1.80 2001/12/05 18:23:48 lazarus
Added events to Calendar
Shane

2
lcl/vclglobals.pp
View File

@ -87,6 +87,8 @@ csPopupMenu = 47;
csHintWindow = 48;
csCalendar = 49;
csArrow = 50;
type
//TODO: check this against lcllinux