diff options
| -rw-r--r-- | examples/gui/calendar/calendartest.lpi | 285 | ||||
| -rw-r--r-- | examples/gui/calendar/calendartest.lpr | 128 | ||||
| -rw-r--r-- | examples/gui/calendar/extrafpc.cfg | 5 | ||||
| -rw-r--r-- | src/corelib/gfx_popupwindow.pas | 53 | ||||
| -rw-r--r-- | src/gui/fpgui_package.lpk | 14 | ||||
| -rw-r--r-- | src/gui/fpgui_package.pas | 2 | ||||
| -rw-r--r-- | src/gui/gui_basegrid.pas | 15 | ||||
| -rw-r--r-- | src/gui/gui_grid.pas | 2 | ||||
| -rw-r--r-- | src/gui/gui_popupcalendar.pas | 346 | ||||
| -rw-r--r-- | src/gui/gui_scrollbar.pas | 2 |
10 files changed, 843 insertions, 9 deletions
diff --git a/examples/gui/calendar/calendartest.lpi b/examples/gui/calendar/calendartest.lpi new file mode 100644 index 00000000..27ab544a --- /dev/null +++ b/examples/gui/calendar/calendartest.lpi @@ -0,0 +1,285 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="6"/> + <General> + <MainUnit Value="0"/> + <TargetFileExt Value=""/> + <ActiveEditorIndexAtStart Value="1"/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + <Language Value=""/> + <CharSet Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="fpgui_package"/> + <MinVersion Minor="5" Release="1" Valid="True"/> + </Item1> + </RequiredPackages> + <Units Count="16"> + <Unit0> + <Filename Value="calendartest.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="calendartest"/> + <CursorPos X="29" Y="19"/> + <TopLine Value="1"/> + <EditorIndex Value="0"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit0> + <Unit1> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <UnitName Value="gui_popupcalendar"/> + <CursorPos X="24" Y="32"/> + <TopLine Value="30"/> + <EditorIndex Value="1"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit1> + <Unit2> + <Filename Value="../../../src/gui/gui_grid.pas"/> + <UnitName Value="gui_grid"/> + <CursorPos X="28" Y="206"/> + <TopLine Value="164"/> + <EditorIndex Value="2"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit2> + <Unit3> + <Filename Value="../../../src/gui/gui_customgrid.pas"/> + <UnitName Value="gui_customgrid"/> + <CursorPos X="32" Y="54"/> + <TopLine Value="48"/> + <EditorIndex Value="3"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit3> + <Unit4> + <Filename Value="../../../src/gui/gui_basegrid.pas"/> + <UnitName Value="gui_basegrid"/> + <CursorPos X="17" Y="135"/> + <TopLine Value="87"/> + <EditorIndex Value="4"/> + <UsageCount Value="10"/> + <Loaded Value="True"/> + </Unit4> + <Unit5> + <Filename Value="../../../src/corelib/gfx_popupwindow.pas"/> + <UnitName Value="gfx_popupwindow"/> + <CursorPos X="35" Y="238"/> + <TopLine Value="166"/> + <UsageCount Value="10"/> + </Unit5> + <Unit6> + <Filename Value="../../../src/gui/gui_form.pas"/> + <UnitName Value="gui_form"/> + <CursorPos X="1" Y="12"/> + <TopLine Value="1"/> + <UsageCount Value="10"/> + </Unit6> + <Unit7> + <Filename Value="../../../src/gui/gui_combobox.pas"/> + <UnitName Value="gui_combobox"/> + <CursorPos X="16" Y="188"/> + <TopLine Value="171"/> + <UsageCount Value="10"/> + </Unit7> + <Unit8> + <Filename Value="../../../src/gui/gui_button.pas"/> + <UnitName Value="gui_button"/> + <CursorPos X="25" Y="91"/> + <TopLine Value="54"/> + <UsageCount Value="10"/> + </Unit8> + <Unit9> + <Filename Value="../../../src/gui/gui_listbox.pas"/> + <UnitName Value="gui_listbox"/> + <CursorPos X="1" Y="491"/> + <TopLine Value="475"/> + <UsageCount Value="10"/> + </Unit9> + <Unit10> + <Filename Value="../../../src/corelib/gfxbase.pas"/> + <UnitName Value="gfxbase"/> + <CursorPos X="3" Y="839"/> + <TopLine Value="837"/> + <UsageCount Value="10"/> + </Unit10> + <Unit11> + <Filename Value="../../../src/corelib/gfx_widget.pas"/> + <UnitName Value="gfx_widget"/> + <CursorPos X="3" Y="795"/> + <TopLine Value="790"/> + <UsageCount Value="10"/> + </Unit11> + <Unit12> + <Filename Value="../../../src/gui/gui_scrollbar.pas"/> + <UnitName Value="gui_scrollbar"/> + <CursorPos X="66" Y="42"/> + <TopLine Value="36"/> + <UsageCount Value="10"/> + </Unit12> + <Unit13> + <Filename Value="/opt/fpc-2.2.0/src/rtl/objpas/sysutils/sysinth.inc"/> + <CursorPos X="18" Y="107"/> + <TopLine Value="86"/> + <UsageCount Value="10"/> + </Unit13> + <Unit14> + <Filename Value="/opt/fpc-2.2.0/src/rtl/objpas/sysutils/datih.inc"/> + <CursorPos X="14" Y="115"/> + <TopLine Value="91"/> + <UsageCount Value="10"/> + </Unit14> + <Unit15> + <Filename Value="../../../src/gui/gui_memo.pas"/> + <UnitName Value="gui_memo"/> + <CursorPos X="1" Y="22"/> + <TopLine Value="1"/> + <UsageCount Value="10"/> + </Unit15> + </Units> + <JumpHistory Count="29" HistoryIndex="28"> + <Position1> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="111" Column="5" TopLine="58"/> + </Position1> + <Position2> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="144" Column="21" TopLine="138"/> + </Position2> + <Position3> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="95" Column="5" TopLine="42"/> + </Position3> + <Position4> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="94" Column="51" TopLine="88"/> + </Position4> + <Position5> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="92" Column="66" TopLine="59"/> + </Position5> + <Position6> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="94" Column="1" TopLine="68"/> + </Position6> + <Position7> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="61" Column="11" TopLine="59"/> + </Position7> + <Position8> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="71" Column="43" TopLine="59"/> + </Position8> + <Position9> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="69" Column="40" TopLine="45"/> + </Position9> + <Position10> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="70" Column="40" TopLine="47"/> + </Position10> + <Position11> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="151" Column="5" TopLine="98"/> + </Position11> + <Position12> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="157" Column="5" TopLine="104"/> + </Position12> + <Position13> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="220" Column="28" TopLine="178"/> + </Position13> + <Position14> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="156" Column="12" TopLine="126"/> + </Position14> + <Position15> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="150" Column="9" TopLine="126"/> + </Position15> + <Position16> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="151" Column="3" TopLine="148"/> + </Position16> + <Position17> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="115" Column="38" TopLine="100"/> + </Position17> + <Position18> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="108" Column="30" TopLine="100"/> + </Position18> + <Position19> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="71" Column="45" TopLine="68"/> + </Position19> + <Position20> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="172" Column="5" TopLine="114"/> + </Position20> + <Position21> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="272" Column="27" TopLine="226"/> + </Position21> + <Position22> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="171" Column="18" TopLine="156"/> + </Position22> + <Position23> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="156" Column="1" TopLine="151"/> + </Position23> + <Position24> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="19" Column="53" TopLine="17"/> + </Position24> + <Position25> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="94" Column="37" TopLine="90"/> + </Position25> + <Position26> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="95" Column="17" TopLine="71"/> + </Position26> + <Position27> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="98" Column="16" TopLine="72"/> + </Position27> + <Position28> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="102" Column="1" TopLine="73"/> + </Position28> + <Position29> + <Filename Value="../../../src/gui/gui_popupcalendar.pas"/> + <Caret Line="5" Column="50" TopLine="1"/> + </Position29> + </JumpHistory> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/examples/gui/calendar/calendartest.lpr b/examples/gui/calendar/calendartest.lpr new file mode 100644 index 00000000..163961fa --- /dev/null +++ b/examples/gui/calendar/calendartest.lpr @@ -0,0 +1,128 @@ +{ + This is still under development!!!!!!!!!!!!!!!!! +} + +program calendartest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Classes, SysUtils, fpgfx, gui_form, gui_popupcalendar, gui_edit, + gui_button, gui_label, gfx_popupwindow; + +type + TMainForm = class(TfpgForm) + private + procedure btnDownClicked(Sender: TObject); + procedure DoDropDown; + public + {@VFD_HEAD_BEGIN: MainForm} + edtName1: TfpgEdit; + btnName1: TfpgButton; + lblName1: TfpgLabel; + lblName2: TfpgLabel; + {@VFD_HEAD_END: MainForm} + FDropDown: TfpgPopupCalendar; + procedure AfterCreate; override; + end; + +{@VFD_NEWFORM_DECL} + +{ TMainForm } + +procedure TMainForm.btnDownClicked(Sender: TObject); +begin + DoDropDown; +end; + +procedure TMainForm.DoDropDown; +begin + if (not Assigned(FDropDown)) or (not FDropDown.HasHandle) then + begin + FDropDown := TfpgPopupCalendar.Create(nil); + FDropDown.ShowAt(self, edtName1.Left, edtName1.Top+edtName1.Height); + FDropDown.PopupFrame:= True; + end + else + begin + FDropDown.Close; + FreeAndNil(FDropDown); + end; +end; + +procedure TMainForm.AfterCreate; +begin + inherited AfterCreate; + {@VFD_BODY_BEGIN: MainForm} + Name := 'MainForm'; + SetPosition(100, 100, 417, 270); + WindowTitle := 'fpGUI Calendar Test'; + WindowPosition := wpUser; + + edtName1 := TfpgEdit.Create(self); + with edtName1 do + begin + Name := 'edtName1'; + SetPosition(84, 48, 120, 22); + Text := ''; + FontDesc := '#Edit1'; + end; + + btnName1 := TfpgButton.Create(self); + with btnName1 do + begin + Name := 'btnName1'; + SetPosition(204, 48, 19, 22); + Text := ''; + FontDesc := '#Label1'; + ImageName := 'sys.sb.down'; + OnClick := @btnDownClicked; + end; + + lblName1 := TfpgLabel.Create(self); + with lblName1 do + begin + Name := 'lblName1'; + SetPosition(84, 32, 80, 16); + Text := 'Enter a date:'; + FontDesc := '#Label1'; + end; + + lblName2 := TfpgLabel.Create(self); + with lblName2 do + begin + Name := 'lblName2'; + SetPosition(68, 116, 276, 16); + Text := '***** This is still Work-In-Progress *****'; + FontDesc := '#Label2'; + end; + + {@VFD_BODY_END: MainForm} +end; + + +{@VFD_NEWFORM_IMPL} + +procedure MainProc; +var + frm: TMainForm; +begin + fpgApplication.Initialize; + frm := TMainForm.Create(nil); + try + frm.Show; + fpgApplication.Run; + finally + frm.Free; + end; +end; + +begin + MainProc; +end. + + + diff --git a/examples/gui/calendar/extrafpc.cfg b/examples/gui/calendar/extrafpc.cfg new file mode 100644 index 00000000..073dc4b6 --- /dev/null +++ b/examples/gui/calendar/extrafpc.cfg @@ -0,0 +1,5 @@ +-FUunits +-Fu../../../lib +-Xs +-XX +-CX diff --git a/src/corelib/gfx_popupwindow.pas b/src/corelib/gfx_popupwindow.pas index 2ce499da..3450b63d 100644 --- a/src/corelib/gfx_popupwindow.pas +++ b/src/corelib/gfx_popupwindow.pas @@ -16,17 +16,22 @@ type TfpgPopupWindow = class(TfpgWidget) private FDontCloseWidget: TfpgWidget; + FPopupFrame: boolean; + procedure SetPopupFrame(const AValue: boolean); protected procedure MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE; procedure AdjustWindowStyle; override; procedure HandleShow; override; procedure HandleHide; override; procedure HandleClose; virtual; + procedure ProcessPopupFrame; virtual; + procedure DoPaintPopupFrame; virtual; public constructor Create(AOwner: TComponent); override; procedure ShowAt(AWidget: TfpgWidget; x, y: TfpgCoord); procedure Close; virtual; property DontCloseWidget: TfpgWidget read FDontCloseWidget write FDontCloseWidget; + property PopupFrame: boolean read FPopupFrame write SetPopupFrame; end; @@ -170,6 +175,14 @@ end; { TfpgPopupWindow } +procedure TfpgPopupWindow.SetPopupFrame(const AValue: boolean); +begin + if FPopupFrame = AValue then + Exit; //==> + FPopupFrame := AValue; + ProcessPopupFrame; +end; + procedure TfpgPopupWindow.MsgClose(var msg: TfpgMessageRec); begin HandleClose; @@ -199,12 +212,52 @@ begin HandleHide; end; +procedure TfpgPopupWindow.ProcessPopupFrame; +var + i: integer; +begin + if PopupFrame then + begin + for i := 0 to ComponentCount-1 do + begin + if Components[i] is TfpgWidget then + TfpgWidget(Components[i]).Anchors := [anRight, anBottom]; + end; + // make space for the frame +// Width := Width + 1; +// Height := Height + 1; +// UpdateWindowPosition; + HandleResize(Width+1, Height+1); + UpdateWindowPosition; + + for i := 0 to ComponentCount-1 do + begin + if Components[i] is TfpgWidget then + TfpgWidget(Components[i]).Anchors := [anLeft, anTop]; + end; + HandleResize(Width+1, Height+1); + UpdateWindowPosition; + + Canvas.BeginDraw; + DoPaintPopupFrame; + Canvas.EndDraw; + end; +end; + +procedure TfpgPopupWindow.DoPaintPopupFrame; +begin + Canvas.SetLineStyle(1, lsSolid); + Canvas.SetColor(clWidgetFrame); + Canvas.DrawRectangle(0, 0, Width, Height); +end; + constructor TfpgPopupWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); WindowType := wtPopup; FDontCloseWidget := nil; Parent := nil; + FPopupFrame := False; end; procedure TfpgPopupWindow.ShowAt(AWidget: TfpgWidget; x, y: TfpgCoord); diff --git a/src/gui/fpgui_package.lpk b/src/gui/fpgui_package.lpk index 9bfe855d..f65ccde6 100644 --- a/src/gui/fpgui_package.lpk +++ b/src/gui/fpgui_package.lpk @@ -26,7 +26,7 @@ <License Value="Modified LGPL "/> <Version Minor="5" Release="1"/> - <Files Count="26"> + <Files Count="27"> <Item1> <Filename Value="gui_button.pas"/> <UnitName Value="gui_button"/> @@ -131,15 +131,19 @@ <Filename Value="messagedialog.inc"/> <Type Value="Binary"/> </Item26> + <Item27> + <Filename Value="gui_popupcalendar.pas"/> + <UnitName Value="gui_popupcalendar"/> + </Item27> </Files> <RequiredPkgs Count="2"> <Item1> - <PackageName Value="FCL"/> - <MinVersion Major="1" Valid="True"/> - </Item1> - <Item2> <PackageName Value="fpgfx_package"/> <MinVersion Minor="5" Valid="True"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + <MinVersion Major="1" Valid="True"/> </Item2> </RequiredPkgs> <UsageOptions> diff --git a/src/gui/fpgui_package.pas b/src/gui/fpgui_package.pas index d26bd4e1..bc3ab192 100644 --- a/src/gui/fpgui_package.pas +++ b/src/gui/fpgui_package.pas @@ -11,7 +11,7 @@ uses gui_listbox, gui_memo, gui_scrollbar, gui_bevel, gui_checkbox, gui_radiobutton, gui_trackbar, gui_tab, gui_basegrid, gui_listview, gui_customgrid, gui_progressbar, gui_menu, gui_style, gui_grid, gui_tree, - gui_iniutils, gui_mru, fpgui_db; + gui_iniutils, gui_mru, fpgui_db, gui_popupcalendar; implementation diff --git a/src/gui/gui_basegrid.pas b/src/gui/gui_basegrid.pas index 6da2f53a..79dbd899 100644 --- a/src/gui/gui_basegrid.pas +++ b/src/gui/gui_basegrid.pas @@ -66,6 +66,7 @@ type FFont: TfpgFont; FHeaderFont: TfpgFont; FRowSelect: boolean; + FScrollBarStyle: TfpgScrollStyle; FShowGrid: boolean; FShowHeader: boolean; FTemp: integer; @@ -77,6 +78,7 @@ type procedure SetFontDesc(const AValue: string); procedure SetHeaderFontDesc(const AValue: string); procedure SetRowSelect(const AValue: boolean); + procedure SetScrollBarStyle(const AValue: TfpgScrollStyle); procedure VScrollBarMove(Sender: TObject; position: integer); procedure SetBackgroundColor(const AValue: TfpgColor); procedure SetDefaultColWidth(const AValue: integer); @@ -121,6 +123,7 @@ type property RowCount: integer read GetRowCount; property ShowHeader: boolean read FShowHeader write SetShowHeader default True; property ShowGrid: boolean read FShowGrid write SetShowGrid default True; + property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth; property HeaderHeight: integer read FHeaderHeight; property ColResizing: boolean read FColResizing write FColResizing; property ColumnWidth[ACol: integer]: integer read GetColumnWidth write SetColumnWidth; @@ -179,6 +182,13 @@ begin RePaint; end; +procedure TfpgBaseGrid.SetScrollBarStyle(const AValue: TfpgScrollStyle); +begin + if FScrollBarStyle = AValue then + Exit; //==> + FScrollBarStyle := AValue; +end; + procedure TfpgBaseGrid.VScrollBarMove(Sender: TObject; position: integer); begin if FFirstRow <> position then @@ -404,7 +414,7 @@ begin // This needs improving while resizing if cw > vw then - FHScrollBar.Visible := True + FHScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssVertical]) else begin FHScrollBar.Visible := False; @@ -413,7 +423,7 @@ begin // This needs improving while resizing if (RowCount > VisibleLines) then - FVScrollBar.Visible := True + FVScrollBar.Visible := not (FScrollBarStyle in [ssNone, ssHorizontal]) else begin FVScrollBar.Visible := False; @@ -982,6 +992,7 @@ begin FShowHeader := True; FShowGrid := True; FRowSelect := False; + FScrollBarStyle := ssAutoBoth; FFont := fpgGetFont('#Grid'); FHeaderFont := fpgGetFont('#GridHeader'); diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas index 0d64c09a..ef56ff40 100644 --- a/src/gui/gui_grid.pas +++ b/src/gui/gui_grid.pas @@ -139,6 +139,7 @@ type property ColumnCount; property Columns; property FocusRow; + property ScrollBarStyle; property OnRowChange; property OnDoubleClick; end; @@ -198,6 +199,7 @@ type property RowSelect; property ColumnCount; property RowCount; + property ScrollBarStyle; property ShowHeader; property ShowGrid; property HeaderHeight; diff --git a/src/gui/gui_popupcalendar.pas b/src/gui/gui_popupcalendar.pas new file mode 100644 index 00000000..e9bc41c8 --- /dev/null +++ b/src/gui/gui_popupcalendar.pas @@ -0,0 +1,346 @@ +{ + 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: + A calendar component. Soon it would be possible to use it in a + popup windows like Calender Combobox, or directly in a Form. +} + +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. +} + +interface + +uses + SysUtils, Classes, gfxbase, fpgfx, gui_edit, + gfx_widget, gui_form, gui_label, gui_button, + gui_listbox, gui_memo, gui_combobox, gui_grid, + gui_dialogs, gui_checkbox, gui_tree, gui_trackbar, + gui_progressbar, gui_radiobutton, gui_tab, gui_menu, + gui_bevel, gfx_popupwindow; + +type + + TfpgPopupCalendar = class(TfpgPopupWindow) + private + FMonthOffset: integer; + FDate: TDateTime; + function GetDateElement(Index: integer): Word; + procedure PopulateDays; + procedure CalculateMonthOffset; + function CalculateCellDay(const ACol, ARow: LongWord): Word; + procedure SetDateElement(Index: integer; const AValue: Word); + procedure SetDateValue(const AValue: TDateTime); + procedure UpdateCalendar; + procedure btnYearUpClicked(Sender: TObject); + procedure btnYearDownClicked(Sender: TObject); + procedure btnMonthUpClicked(Sender: TObject); + procedure btnMonthDownClicked(Sender: TObject); + procedure grdName1DoubleClick(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + protected + procedure HandlePaint; 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; + property Month: Word index 2 read GetDateElement write SetDateElement; + property Year: Word index 3 read GetDateElement write SetDateElement; + published + property Value: TDateTime read FDate write SetDateValue; + end; + +{@VFD_NEWFORM_DECL} + +implementation + +uses + gui_scrollbar; + +{@VFD_NEWFORM_IMPL} + +procedure TfpgPopupCalendar.PopulateDays; +var + r, c: integer; + lCellDay: Word; + lCellText: string; +begin + lCellText := ''; + for r := 0 to 6 do + for c := 1 to 7 do + begin + if r = 0 then + grdName1.ColumnTitle[c] := ShortDayNames[c] + else + begin + lCellDay := CalculateCellDay(c, r); + if lCellDay = 0 then + grdName1.Cells[c, r] := '' + else + grdName1.Cells[c, r] := IntToStr(lCellDay); + end; + end; +// drawtext(canvas, +// msestring(inttostr(dayof(incday(ffirstdate,cell.row*7+cell.col)))), +// rect,flags1); + +end; + +procedure TfpgPopupCalendar.grdName1DoubleClick(Sender: TObject; + AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); +var + lD: Word; + s: string; +begin + s := grdName1.Cells[grdName1.FocusCol, grdName1.FocusRow]; + if s = '' then + Exit; //==> + lD := StrToInt(s); + Value := EncodeDate(Year, Month, lD); + {$IFDEF DEBUG} + writeln('Selected date: ', FormatDateTime('yyyy-mm-dd', Value)); + {$ENDIF} + Close; +end; + +function TfpgPopupCalendar.GetDateElement(Index: integer): Word; +var + lD, lM, lY: Word; +begin + DecodeDate(FDate, lY, lM, lD); + case Index of + 1: Result := lD; + 2: Result := lM; + 3: Result := lY; + end; +end; + +procedure TfpgPopupCalendar.CalculateMonthOffset; +var + lD, lM, lY: Word; + lTheFirst: TDateTime; +begin + if FDate > 0 then + begin + DecodeDate(FDate, lY, lM, lD); + lTheFirst := EncodeDate(lY, lM, 1); + FMonthOffset := 2 - DayOfWeek(lTheFirst); + end; +end; + +function TfpgPopupCalendar.CalculateCellDay(const ACol, ARow: LongWord): Word; +begin + Result := FMonthOffset + (ACol-1) + (ARow-1) * 7; + if (Result < 1) or (Result > MonthDays[IsLeapYear(Year), Month]) then + Result := 0; +end; + +procedure TfpgPopupCalendar.SetDateElement(Index: integer; const AValue: Word); +var + lD, lM, lY: Word; +begin + if AValue > 0 then + begin + DecodeDate(FDate, lY, lM, lD); + case Index of + 1: lD := AValue; + 2: lM := AValue; + 3: lY := AValue; + end; + FDate := EncodeDate(lY, lM, lD); + UpdateCalendar; + end; +end; + +procedure TfpgPopupCalendar.SetDateValue(const AValue: TDateTime); +begin + if FDate = AValue then + Exit; //==> + FDate := AValue; + UpdateCalendar; +end; + +procedure TfpgPopupCalendar.UpdateCalendar; +begin + CalculateMonthOffset; + PopulateDays; + edtYear.Text := IntToStr(Year); + edtMonth.Text := LongMonthNames[Month]; +end; + +procedure TfpgPopupCalendar.btnYearUpClicked(Sender: TObject); +begin + Year := Year + 1; +end; + +procedure TfpgPopupCalendar.btnYearDownClicked(Sender: TObject); +begin + Year := Year - 1; +end; + +procedure TfpgPopupCalendar.btnMonthUpClicked(Sender: TObject); +begin + Value := IncMonth(FDate); +end; + +procedure TfpgPopupCalendar.btnMonthDownClicked(Sender: TObject); +begin + Value := IncMonth(FDate, -1); +end; + +procedure TfpgPopupCalendar.HandlePaint; +begin + Canvas.BeginDraw; + inherited HandlePaint; + if PopupFrame then + Canvas.SetClipRect(fpgRect(1, 1, Width-2, Height-2)); + Canvas.Clear(clWindowBackground); + Canvas.ClearClipRect; + Canvas.EndDraw; +end; + +constructor TfpgPopupCalendar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + AfterCreate; + FDate := Date; + FMonthOffset := 0; + UpdateCalendar; +end; + +procedure TfpgPopupCalendar.AfterCreate; +begin + {@VFD_BODY_BEGIN: fpgPopupCalendar} + Name := 'fpgPopupCalendar'; + SetPosition(100, 268, 233, 179); +// WindowTitle := 'fpgPopupCalendar'; +// WindowPosition := wpUser; +// Sizeable := False; + + edtYear := TfpgEdit.Create(self); + with edtYear do + begin + Name := 'edtYear'; + SetPosition(0, 0, 72, 22); + Text := ''; + FontDesc := '#Edit1'; + Focusable := False; + end; + + btnYearUp := TfpgButton.Create(self); + with btnYearUp do + begin + Name := 'btnYearUp'; + SetPosition(72, 0, 13, 11); + Text := ''; + FontDesc := '#Label1'; + ImageMargin := 0; + ImageName := 'sys.sb.up'; + Embedded := True; + OnClick := @btnYearUpClicked; + end; + + btnYearDown := TfpgButton.Create(self); + with btnYearDown do + begin + Name := 'btnYearDown'; + SetPosition(72, 11, 13, 11); + Text := ''; + FontDesc := '#Label1'; + ImageMargin := 0; + ImageName := 'sys.sb.down'; + Embedded := True; + OnClick := @btnYearDownClicked; + end; + + edtMonth := TfpgEdit.Create(self); + with edtMonth do + begin + Name := 'edtMonth'; + SetPosition(85, 0, 136, 22); + Text := ''; + FontDesc := '#Edit1'; + Focusable := False; + end; + + btnMonthUp := TfpgButton.Create(self); + with btnMonthUp do + begin + Name := 'btnMonthUp'; + SetPosition(220, 0, 13, 11); + Text := ''; + FontDesc := '#Label1'; + ImageMargin := 0; + ImageName := 'sys.sb.up'; + Embedded := True; + OnClick := @btnMonthUpClicked; + end; + + btnMonthDown := TfpgButton.Create(self); + with btnMonthDown do + begin + Name := 'btnMonthDown'; + SetPosition(220, 11, 13, 11); + Text := ''; + FontDesc := '#Label1'; + ImageMargin := 0; + ImageName := 'sys.sb.down'; + Embedded := True; + OnClick := @btnMonthDownClicked; + end; + + grdName1 := TfpgStringGrid.Create(self); + with grdName1 do + begin + Name := 'grdName1'; + SetPosition(0, 23, 233, 156); + AddColumn('Mon', 33, taLeftJustify); + AddColumn('Tue', 32, taLeftJustify); + AddColumn('Wed', 33, taLeftJustify); + AddColumn('Thu', 32, taLeftJustify); + AddColumn('Fri', 33, taLeftJustify); + AddColumn('Sat', 32, taLeftJustify); + AddColumn('Sun', 33, taLeftJustify); + FontDesc := '#Grid'; + HeaderFontDesc := '#GridHeader'; + RowCount := 6; + ScrollBarStyle := ssNone; + ColResizing := False; + OnDoubleClick:=@grdName1DoubleClick; + end; + + {@VFD_BODY_END: fpgPopupCalendar} +end; + + +end. diff --git a/src/gui/gui_scrollbar.pas b/src/gui/gui_scrollbar.pas index e1199167..17413e21 100644 --- a/src/gui/gui_scrollbar.pas +++ b/src/gui/gui_scrollbar.pas @@ -39,7 +39,7 @@ uses type TScrollNotifyEvent = procedure(Sender: TObject; position: integer) of object; - { TfpgScrollBar } + TfpgScrollStyle = (ssNone, ssHorizontal, ssVertical, ssAutoBoth); TfpgScrollBar = class(TfpgWidget) private |