summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/calendar/calendartest.lpr2
-rw-r--r--extras/code_templates/lazarus.dci17
-rw-r--r--src/corelib/fpgfx.pas4
-rw-r--r--src/corelib/gfx_widget.pas9
-rw-r--r--src/gui/gui_edit.pas1
-rw-r--r--src/gui/gui_grid.pas1
-rw-r--r--src/gui/gui_popupcalendar.pas130
7 files changed, 141 insertions, 23 deletions
diff --git a/examples/gui/calendar/calendartest.lpr b/examples/gui/calendar/calendartest.lpr
index 6a16d853..df924f0b 100644
--- a/examples/gui/calendar/calendartest.lpr
+++ b/examples/gui/calendar/calendartest.lpr
@@ -46,7 +46,7 @@ begin
FDropDown := TfpgPopupCalendar.Create(nil);
FDropDown.ShowAt(self, edtName1.Left, edtName1.Top+edtName1.Height);
FDropDown.PopupFrame:= True;
- FDropDown.grdName1.SetFocus;
+// FDropDown.grdName1.SetFocus;
end
else
begin
diff --git a/extras/code_templates/lazarus.dci b/extras/code_templates/lazarus.dci
index 1d45da00..c551de04 100644
--- a/extras/code_templates/lazarus.dci
+++ b/extras/code_templates/lazarus.dci
@@ -40,4 +40,21 @@ begin
MainProc;
end.
+[fpguihdr | fpGUI unit header]
+{
+ fpGUI - Free Pascal GUI Library
+
+ Copyright (C) 2006 - 2007 See the file AUTHORS.txt, included in this
+ distribution, for details of the copyright.
+
+ See the file COPYING.modifiedLGPL, included in this distribution,
+ for details about redistributing fpGUI.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ Description:
+ |.
+}
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index 9975e795..a10685f6 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -1,6 +1,7 @@
unit fpgfx;
{$mode objfpc}{$H+}
+{.$INTERFACES CORBA}
interface
@@ -59,12 +60,15 @@ type
{ Keyboard }
TKeyEvent = procedure(Sender: TObject; AKey: Word; AShift: TShiftState) of object;
TKeyCharEvent = procedure(Sender: TObject; AKeyChar: Char) of object;
+ TKeyPressEvent = procedure(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean) of object;
{ Mouse }
TMouseButtonEvent = procedure(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint) of object;
TMouseMoveEvent = procedure(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint) of object;
TMouseWheelEvent = procedure(Sender: TObject; AShift: TShiftState; AWheelDelta: Single; const AMousePos: TPoint) of object;
{ Painting }
TPaintEvent = procedure(Sender: TObject{; const ARect: TfpgRect}) of object;
+
+
type
TSizeParams = record
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index ce96922e..5c195d60 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -24,6 +24,7 @@ type
FOnMouseMove: TMouseMoveEvent;
FOnMouseUp: TMouseButtonEvent;
FOnPaint: TPaintEvent;
+ FOnKeyPress: TKeyPressEvent;
FOnScreen: boolean;
procedure MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
procedure MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
@@ -87,7 +88,7 @@ type
property OnMouseDown: TMouseButtonEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseButtonEvent read FOnMouseUp write FOnMouseUp;
property OnDoubleClick: TMouseButtonEvent read FOnDoubleClick write FOnDoubleClick;
- //property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
+ property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -536,13 +537,13 @@ begin
end;
procedure TfpgWidget.HandleKeyPress(var keycode: word; var shiftstate: TShiftState;
- var consumed: boolean);
+ var consumed: boolean);
var
wg: TfpgWidget;
dir: integer;
begin
- //if Assigned(OnKeyPress) then
- //OnKeyPress(self, keycode, shiftstate, consumed);
+ if Assigned(OnKeyPress) then
+ OnKeyPress(self, keycode, shiftstate, consumed);
if consumed then
Exit; //==>
diff --git a/src/gui/gui_edit.pas b/src/gui/gui_edit.pas
index 04725c3b..45978bba 100644
--- a/src/gui/gui_edit.pas
+++ b/src/gui/gui_edit.pas
@@ -95,6 +95,7 @@ type
property OnPaint;
property OnMouseExit;
property OnMouseEnter;
+ property OnKeyPress;
end;
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
index 4527d7a1..ec277fe0 100644
--- a/src/gui/gui_grid.pas
+++ b/src/gui/gui_grid.pas
@@ -208,6 +208,7 @@ type
property OnFocusChange;
property OnRowChange;
property OnDoubleClick;
+ property OnKeyPress;
end;
diff --git a/src/gui/gui_popupcalendar.pas b/src/gui/gui_popupcalendar.pas
index 89e2a9b2..d78f8353 100644
--- a/src/gui/gui_popupcalendar.pas
+++ b/src/gui/gui_popupcalendar.pas
@@ -20,16 +20,15 @@ unit gui_popupcalendar;
{$mode objfpc}{$H+}
-{$Define DEBUG} // while developing the component
-
{
- TODO:
- * This is still under development!!!!!!!!!!!!!!!!!!!!!!
- * Support highlighting special days.
- * Support custom colors.
- * Must be able to switch the first day of the week.
- * Keyboard support.
+ * This is still under development!!!!!!!!!
}
+{$Define DEBUG} // while developing the component
+
+
+{ todo: Support highlighting special days. }
+{ todo: Support custom colors. }
+{ todo: Must be able to switch the first day of the week. }
interface
@@ -47,6 +46,15 @@ type
private
FMonthOffset: integer;
FDate: TDateTime;
+ {@VFD_HEAD_BEGIN: fpgPopupCalendar}
+ edtYear: TfpgEdit;
+ btnYearUp: TfpgButton;
+ btnYearDown: TfpgButton;
+ edtMonth: TfpgEdit;
+ btnMonthUp: TfpgButton;
+ btnMonthDown: TfpgButton;
+ grdName1: TfpgStringGrid;
+ {@VFD_HEAD_END: fpgPopupCalendar}
function GetDateElement(Index: integer): Word;
procedure PopulateDays;
procedure CalculateMonthOffset;
@@ -59,18 +67,13 @@ type
procedure btnMonthUpClicked(Sender: TObject);
procedure btnMonthDownClicked(Sender: TObject);
procedure grdName1DoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure grdName1KeyPress(Sender: TObject; var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean);
+ procedure TearDown;
protected
procedure HandlePaint; override;
+ procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
+ procedure HandleShow; override;
public
- {@VFD_HEAD_BEGIN: fpgPopupCalendar}
- edtYear: TfpgEdit;
- btnYearUp: TfpgButton;
- btnYearDown: TfpgButton;
- edtMonth: TfpgEdit;
- btnMonthUp: TfpgButton;
- btnMonthDown: TfpgButton;
- grdName1: TfpgStringGrid;
- {@VFD_HEAD_END: fpgPopupCalendar}
constructor Create(AOwner: TComponent); override;
procedure AfterCreate;
property Day: Word index 1 read GetDateElement write SetDateElement;
@@ -116,6 +119,19 @@ end;
procedure TfpgPopupCalendar.grdName1DoubleClick(Sender: TObject;
AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+begin
+ TearDown;
+end;
+
+procedure TfpgPopupCalendar.grdName1KeyPress(Sender: TObject;
+ var KeyCode: word; var ShiftState: TShiftState; var Consumed: boolean);
+begin
+ // Pass the grid event on to the TfpgPopupCalender instance.
+ HandleKeyPress(KeyCode, ShiftState, consumed);
+ Consumed := True;
+end;
+
+procedure TfpgPopupCalendar.TearDown;
var
lD: Word;
s: string;
@@ -233,6 +249,79 @@ begin
Canvas.EndDraw;
end;
+procedure TfpgPopupCalendar.HandleKeyPress(var keycode: word;
+ var shiftstate: TShiftState; var consumed: boolean);
+begin
+ case keycode of
+ keyUp:
+ begin
+ if (ssCtrl in shiftstate) then
+ begin
+ btnYearUpClicked(nil); // Ctrl+Up Arrow
+ consumed := True;
+ end;
+ end;
+ keyDown:
+ begin
+ if (ssCtrl in shiftstate) then
+ begin
+ btnYearDownClicked(nil); // Ctrl+Down Arrow
+ consumed := True;
+ end;
+ end;
+ keyLeft:
+ begin
+ if (ssCtrl in shiftstate) then
+ begin
+ btnMonthDownClicked(nil); // Ctrl+Left Arrow
+ consumed := True;
+ end;
+ end;
+ keyRight:
+ begin
+ if (ssCtrl in shiftstate) then
+ begin
+ btnMonthUpClicked(nil); // Ctrl+Right Arrow
+ consumed := True;
+ end;
+ end;
+ keyPageUp:
+ begin
+ if (ssCtrl in shiftstate) then
+ btnYearDownClicked(nil) // Ctrl+PageUp
+ else
+ btnMonthDownClicked(nil); // PageUp
+ consumed := True;
+ end;
+ keyPageDown:
+ begin
+ if (ssCtrl in shiftstate) then
+ btnYearUpClicked(nil) // Ctrl+PageDown
+ else
+ btnMonthUpClicked(nil); // PageDown
+ consumed := True;
+ end;
+ end;
+
+ if not consumed then
+ begin
+ if keycode = keyEnter then
+ begin
+ consumed := True;
+ TearDown;
+ end;
+ end;
+
+ if not consumed then
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
+end;
+
+procedure TfpgPopupCalendar.HandleShow;
+begin
+ inherited HandleShow;
+ grdName1.SetFocus;
+end;
+
constructor TfpgPopupCalendar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -272,6 +361,7 @@ begin
FontDesc := '#Label1';
ImageMargin := 0;
ImageName := 'sys.sb.up';
+ Focusable := False;
OnClick := @btnYearUpClicked;
end;
@@ -285,6 +375,7 @@ begin
FontDesc := '#Label1';
ImageMargin := 0;
ImageName := 'sys.sb.down';
+ Focusable := False;
OnClick := @btnYearDownClicked;
end;
@@ -309,6 +400,7 @@ begin
FontDesc := '#Label1';
ImageMargin := 0;
ImageName := 'sys.sb.up';
+ Focusable := False;
OnClick := @btnMonthUpClicked;
end;
@@ -322,6 +414,7 @@ begin
FontDesc := '#Label1';
ImageMargin := 0;
ImageName := 'sys.sb.down';
+ Focusable := False;
OnClick := @btnMonthDownClicked;
end;
@@ -342,7 +435,8 @@ begin
RowCount := 6;
ScrollBarStyle := ssNone;
ColResizing := False;
- OnDoubleClick:=@grdName1DoubleClick;
+ OnDoubleClick := @grdName1DoubleClick;
+ OnKeyPress := @grdName1KeyPress;
end;
{@VFD_BODY_END: fpgPopupCalendar}
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-26 06:13:13 +0000