pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

jvcllaz: Add TJvTMTimeLine incl demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6236 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-03-12 00:40:20 +00:00
parent 9c052434eb
commit 7df733f676
13 changed files with 3486 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
components/jvcllaz/design/JvCustomControls/JvCustomReg.pas
View File

@ -14,14 +14,14 @@ implementation
{$R ../../resource/jvcustomreg.res}
uses
Classes, JvDsgnConsts,
JvTimeLine, JvTimeLineEditor,
PropEdits, ComponentEditors, Controls;
Classes, PropEdits, ComponentEditors, Controls,
JvDsgnConsts, JvTimeLine, JvTMTimeline, JvTimeLineEditor;
procedure Register;
begin
RegisterComponents(RsPaletteJvcl, [
TJvTimeLine
TJvTimeLine,
TJvTMTimeLine
]);
RegisterComponentEditor(TJvCustomTimeLine, TJvTimeLineEditor);
RegisterPropertyEditor(TypeInfo(TDate), TJvTimeLine, 'FirstVisibledate', TDatePropertyEditor)

1
components/jvcllaz/design/JvCustomControls/images/images.txt
View File

@ -1 +1,2 @@
tjvtimeline.bmp
tjvtmtimeline.bmp

94
components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpi Normal file
View File

@ -0,0 +1,94 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="SimpleTLTest1"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="DateTimeCtrls"/>
</Item1>
<Item2>
<PackageName Value="JvCustomLazR"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="SimpleTLTest1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="frmMemoEdit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MemoEditFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="TMTimeLineMainFormU.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="TMTimeLineMainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="SimpleTLTest1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

17
components/jvcllaz/examples/JvTMTimeLine/SimpleTLTest1.lpr Normal file
View File

@ -0,0 +1,17 @@
program SimpleTLTest1;
{$mode objfpc}{$H+}
uses
Forms, datetimectrls, Interfaces,
frmMemoEdit in 'frmMemoEdit.pas' {MemoEditFrm},
TMTimeLineMainFormU in 'TMTimeLineMainFormU.pas' {TMTimeLineMainForm};
{$R *.RES}
begin
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TTMTimeLineMainForm, TMTimeLineMainForm);
Application.Run;
end.

1120
components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

643
components/jvcllaz/examples/JvTMTimeLine/TMTimeLineMainFormU.pas Normal file
View File

@ -0,0 +1,643 @@
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Initial Developer of the Original Code is Peter Thörnqvist [peter3 att users dott sourceforge dott net]
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
All Rights Reserved.
Contributor(s):
Last Modified: 2002-05-26
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Known Issues:
-----------------------------------------------------------------------------}
{$mode objfpc}{$H+}
unit TMTimeLineMainFormU;
{
This demo demonstrates the different properties, methods and events unique to
the Team Manager Timeline.
}
interface
uses
//Windows, Messages,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, Buttons, ImgList, DateTimePicker,
Menus, CheckLst, JvTMTimeLine;
type
TTMTimeLineMainForm = class(TForm)
Splitter1: TSplitter;
Panel1: TPanel;
Label6: TLabel;
lvImages: TListView;
popTimeLine: TPopupMenu;
mnuToday: TMenuItem;
mnuInsertImage: TMenuItem;
mnuRemoveImage: TMenuItem;
N1: TMenuItem;
mnuEditMemo: TMenuItem;
mnuGotoDate: TMenuItem;
StatusBar: TStatusBar;
il16: TImageList;
gbWidths: TGroupBox;
gbDates: TGroupBox;
gbAppearance: TGroupBox;
chkReadOnly: TCheckBox;
chkFlat: TCheckBox;
chkRClick: TCheckBox;
chkEnabled: TCheckBox;
chkShowToday: TCheckBox;
chkShowWeeks: TCheckBox;
chkShowMonths: TCheckBox;
Label13: TLabel;
lbObjFontStyle: TCheckListBox;
Label2: TLabel;
dtpFirstDate: TDateTimePicker;
Label3: TLabel;
dtpSelDate: TDateTimePicker;
Label4: TLabel;
Label5: TLabel;
edImageNo: TEdit;
udImageNo: TUpDown;
dtpImageDate: TDateTimePicker;
btnAdd: TButton;
Label1: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label12: TLabel;
edDayWidth: TEdit;
udDayWidth: TUpDown;
edPenWidth: TEdit;
udPenWidth: TUpDown;
edScrollSmall: TEdit;
udScrollSmall: TUpDown;
edScrollLarge: TEdit;
udScrollLarge: TUpDown;
edButtonWidth: TEdit;
udButtonWidth: TUpDown;
Label11: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
gbMisc: TGroupBox;
btnLoad: TButton;
btnSave: TButton;
gbFonts: TGroupBox;
btnFont: TButton;
btnColor: TButton;
btnMonthFont: TButton;
btnTodayColor: TButton;
btnLineColor: TButton;
btnPenColor: TButton;
Label7: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
chkShowTodayIcon: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure btnFontClick(Sender: TObject);
procedure btnMonthFontClick(Sender: TObject);
procedure chkReadOnlyClick(Sender: TObject);
procedure dtpFirstDateChange(Sender: TObject);
procedure dtpSelDateChange(Sender: TObject);
procedure udDayWidthClick(Sender: TObject; Button: TUDBtnType);
procedure btnColorClick(Sender: TObject);
procedure chkFlatClick(Sender: TObject);
procedure btnAddClick(Sender: TObject);
// procedure lblWebPageClick(Sender: TObject);
procedure btnPenColorClick(Sender: TObject);
procedure udPenWidthClick(Sender: TObject; Button: TUDBtnType);
procedure udScrollSmallClick(Sender: TObject; Button: TUDBtnType);
procedure lvImagesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure btnTodayColorClick(Sender: TObject);
procedure chkRClickClick(Sender: TObject);
procedure mnuTodayClick(Sender: TObject);
procedure mnuInsertImageClick(Sender: TObject);
procedure udScrollLargeClick(Sender: TObject; Button: TUDBtnType);
procedure mnuRemoveImageClick(Sender: TObject);
procedure mnuEditMemoClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure udButtonWidthClick(Sender: TObject; Button: TUDBtnType);
procedure btnLoadClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure lbObjFontStyleClickCheck(Sender: TObject);
procedure chkEnabledClick(Sender: TObject);
procedure mnuGotoDateClick(Sender: TObject);
procedure StatusBarResize(Sender: TObject);
procedure chkShowMonthsClick(Sender: TObject);
procedure chkShowWeeksClick(Sender: TObject);
procedure chkShowTodayClick(Sender: TObject);
procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
procedure btnLineColorClick(Sender: TObject);
procedure chkShowTodayIconClick(Sender: TObject);
private
{ Private declarations }
JvTimeLine1:TJvTMTimeline;
procedure DoClick(Sender: TObject);
procedure DoDateChange(Sender: TObject);
procedure DoDblClick(Sender: TObject);
procedure DoObjectLoad(Sender: TObject; Stream: TStream;var AObject: TObject);
procedure DoObjectSave(Sender: TObject; Stream: TStream;const AObject: TObject);
end;
var
TMTimeLineMainForm: TTMTimeLineMainForm;
implementation
uses
//ShellAPI,
frmMemoEdit;
{$R *.lfm}
procedure TTMTimeLineMainForm.FormCreate(Sender: TObject);
var
i : integer;
begin
//ForceCurrentDirectory := true; // <--- wp
JvTimeLine1 := TJvTMTimeline.Create(self);
JvTimeLine1.Parent := self;
JvTimeLine1.PopUpMenu := popTimeline;
JvTimeLine1.OnChange := @DoDateChange;
JvTimeLine1.OnClick := @DoClick;
JvTimeLine1.OnDblClick := @DoDblClick;
JvTimeLine1.Images := il16;
JvTimeLine1.Align := alClient;
JvTimeLine1.Hint :=
'Double-click a date to edit it''s memo content.' +
LineEnding +
'Right-click to display pop-up menu.';
dtpSelDate.Date := Date;
dtpFirstDate.Date := Date-7;
dtpImageDate.Date := Date+7;
udDayWidth.Position := JvTimeLine1.DayWidth;
chkReadOnly.Checked := JvTimeLine1.ReadOnly;
JvTimeLine1.Date := dtpFirstDate.Date;
JvTimeLine1.SelDate := dtpSelDate.Date;
lbObjFontStyle.Checked[2] := true;
for i := 0 to il16.Count - 1 do
begin
with lvImages.Items.Add do
begin
ImageIndex := i;
Caption := IntToStr(i);
end;
end;
Splitter1.Top := JvTimeLine1.Height + 5;
end;
// Free any stringlists still around in the Objects array by calling the ClearObjects method
// Do NOT call this method unless the Objects array actually contains
// TObjects (or descendants): calling this method if you store ordinal values
// (like integers), will cause an AV
// You can freely mix object types in the array: the will be freed correctly anyway
procedure TTMTimeLineMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
JvTimeLine1.ClearObjects;
end;
// just update the controls when an item in the listview is clicked
procedure TTMTimeLineMainForm.lvImagesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
if Assigned(Item) and Selected then
udImageNo.Position := Item.ImageIndex;
end;
(*
// simple trick that launches your default web-browser and tries to go to my web-page:
// this even works with modem-connections
procedure TTMTimeLineMainForm.lblWebPageClick(Sender: TObject);
begin
ShellExecute(Handle,PChar('open'),PChar('http://www.peter3.com'),nil,nil,SW_SHOWNORMAL);
end;
*)
procedure TTMTimeLineMainForm.btnLoadClick(Sender: TObject);
begin
with TOpenDialog.Create(nil) do
try
Filter := 'Timeline files|*.tm|All files|*.*';
DefaultExt := 'TM';
if Execute then
begin
JvTimeLine1.OnReadObject := @DoObjectLoad;
JvTimeLine1.LoadFromFile(Filename);
end;
finally
Free;
end;
end;
procedure TTMTimeLineMainForm.btnSaveClick(Sender: TObject);
begin
with TSaveDialog.Create(nil) do
try
Filter := 'Timeline files|*.tm|All files|*.*';
DefaultExt := 'TM';
if Execute then
begin
JvTimeLine1.OnWriteObject := @DoObjectSave;
JvTimeLine1.SaveToFile(Filename);
end;
finally
Free;
end;
end;
//****************************************************************************//
// set imageindex for the chosen date
procedure TTMTimeLineMainForm.btnAddClick(Sender: TObject);
begin
JvTimeLine1.ImageIndex[dtpImageDate.DateTime] := udImageNo.Position;
end;
// OnChange is called whenever the FirstDate (the first visible date) changes
// This happens when the user scrolls the display or when you set FirstDate programmatically
procedure TTMTimeLineMainForm.DoDateChange(Sender:TObject);
begin
dtpFirstDate.Date := JvTimeLine1.Date;
StatusBarResize(Sender);
end;
// the click event is called when the timeline is clicked. To keep track of Date
// (i.e. the currently selected date), assign a handler to this event
// If right-click select is true, Date is updated when you right-click too
procedure TTMTimeLineMainForm.DoClick(Sender:TObject);
begin
dtpSelDate.Date := JvTimeLine1.SelDate;
dtpImageDate.Date := JvTimeLine1.SelDate;
end;
// display the memo contents when double.clicking: the day number is
// automatically underlined when the Objects property has a non-nil value
procedure TTMTimeLineMainForm.DoDblClick(Sender:TObject);
begin
mnuEditMemo.Click;
end;
// the timeline font is the font used for the day numbers
procedure TTMTimeLineMainForm.btnFontClick(Sender: TObject);
begin
with TFontDialog.Create(nil) do
try
Font := JvTimeLine1.Font;
if Execute then
JvTimeLine1.Font := Font;
finally
Free;
end;
end;
// the timelines monthfont is the one used for displaying month names and the year
procedure TTMTimeLineMainForm.btnMonthFontClick(Sender: TObject);
begin
with TFontDialog.Create(nil) do
try
Font := JvTimeLine1.MonthFont;
if Execute then
JvTimeLine1.MonthFont := Font;
finally
Free;
end;
end;
// if the timeline is readonly, the scrollbuttons disappear
// and the user cannot scroll with the mouse or keyboard
// the selection frame is also removed
procedure TTMTimeLineMainForm.chkReadOnlyClick(Sender: TObject);
begin
JvTimeLine1.ReadOnly := chkReadOnly.Checked;
StatusBarResize(Sender);
end;
// enabled is not the same as read-only!
procedure TTMTimeLineMainForm.chkEnabledClick(Sender: TObject);
begin
JvTimeLine1.Enabled := chkEnabled.Checked;
end;
// DayWidth is simply the width in pixels for one day
procedure TTMTimeLineMainForm.udDayWidthClick(Sender: TObject; Button: TUDBtnType);
begin
JvTimeLine1.DayWidth := udDayWidth.Position;
udDayWidth.Position := JvTimeLine1.DayWidth;
StatusBarResize(Sender);
end;
// Color is the background color of the control
procedure TTMTimeLineMainForm.btnColorClick(Sender: TObject);
begin
with TColorDialog.Create(nil) do
try
Color := JvTimeLine1.Color;
if Execute then
JvTimeLine1.Color := Color;
finally
Free;
end;
end;
// the timeline doesn't have a Flat property: when setting BorderStyle to bsNone,
// the scroll buttons are automatically changed to have a flat appearance
procedure TTMTimeLineMainForm.chkFlatClick(Sender: TObject);
const
cBStyle:array [boolean] of TBorderStyle = (bsSingle,bsNone);
begin
JvTimeLine1.BorderStyle := cBStyle[chkFlat.Checked];
end;
// update the first visible date from the datetimepicker
procedure TTMTimeLineMainForm.dtpFirstDateChange(Sender: TObject);
begin
JvTimeLine1.Date := dtpFirstDate.Date;
end;
// update the selected date from the datetimepicker
procedure TTMTimeLineMainForm.dtpSelDateChange(Sender: TObject);
begin
JvTimeLine1.SelDate := dtpSelDate.Date;
end;
// change the selection frame Pen color
// You can also change any other property of the Selection, like
// Pen.Width, Pen.Style, Pen.Mode and whether the Selection frame is visible or not
// Setting Pen.Width to 0, has the same effect as Selection.Visible := false
procedure TTMTimeLineMainForm.btnPenColorClick(Sender: TObject);
begin
with TColorDialog.Create(nil) do
try
Color := JvTimeLine1.Selection.Pen.Color;
if Execute then
begin
JvTimeLine1.Selection.Pen.Color := Color;
end;
finally
Free;
end;
end;
// change the Selection frame Pen's width
procedure TTMTimeLineMainForm.udPenWidthClick(Sender: TObject; Button: TUDBtnType);
begin
JvTimeLine1.Selection.Pen.Width := udPenWidth.Position;
end;
// changes the background Color of Today
procedure TTMTimeLineMainForm.btnTodayColorClick(Sender: TObject);
begin
with TColorDialog.Create(nil) do
try
Color := JvTimeLine1.TodayColor;
if Execute then
JvTimeLine1.TodayColor := Color;
finally
Free;
end;
end;
// when RightClickSelect is true, a right-click changes
// the TJvTLTimeline.Date value
procedure TTMTimeLineMainForm.chkRClickClick(Sender: TObject);
begin
JvTimeLine1.RightClickSelect := chkRClick.Checked;
end;
// move today to the middle of the timeline; looks better
procedure TTMTimeLineMainForm.mnuTodayClick(Sender: TObject);
begin
JvTimeLine1.Date := Date - JvTimeLine1.VisibleDays div 2;
end;
// add or replace the image at the currently selected date
// if the imageindex is < 0 or > Images.Count - 1, the image is removed
procedure TTMTimeLineMainForm.mnuInsertImageClick(Sender: TObject);
begin
JvTimeLine1.ImageIndex[JvTimeLine1.SelDate] := udImageNo.Position;
end;
// the SmallChange value is used when you scroll without holding any additional
// keys down (like Shift or Ctrl). You can scroll both with the mouse and with
// the arrow-keys
procedure TTMTimeLineMainForm.udScrollSmallClick(Sender: TObject; Button: TUDBtnType);
begin
JvTimeLine1.SmallChange := udScrollSmall.Position;
end;
// the LargeChange value is used when you hold the Ctrl key while scrolling
procedure TTMTimeLineMainForm.udScrollLargeClick(Sender: TObject; Button: TUDBtnType);
begin
JvTimeLine1.LargeChange := udScrollLarge.Position;
end;
// remove an image by setting the imageindex to -1
procedure TTMTimeLineMainForm.mnuRemoveImageClick(Sender: TObject);
begin
JvTimeLine1.ImageIndex[JvTimeLine1.SelDate] := -1;
end;
// Get or create a TStringlist for the selected date.
// If the user empties the memo, the TStringlist is freed
procedure TTMTimeLineMainForm.mnuEditMemoClick(Sender: TObject);
var S:TStringlist;i:integer;Ico:TIcon;
begin
// WARNING: if you store integers or other ordinal values in the Objects array
// you will get an AV if you call the ClearObjects method:
// JvTimeLine1.Objects[JvTimeLine1.Date] := TObject(Random(100));
S := TStringlist(JvTimeLine1.Objects[JvTimeLine1.SelDate]);
// here's a trick: extract the image from the imagelist and assign t to the icon property of the form:
i := JvTimeLine1.ImageIndex[JvTimeLine1.SelDate];
if i > -1 then
begin
Ico := TIcon.Create;
il16.GetIcon(i,Ico);
end
else
Ico := nil;
if S = nil then
S := TStringlist.Create;
// TIP: add a class function to dialogs that you show modally.
// That way, you can keep all the creating and freeing stuff in the
// dialog unit instead of in the calling unit.
// This reduces the dialog call to a one-liner:
TMemoEditFrm.Edit(S,JvTimeLine1.SelDate,Ico); // the Edit function automatically updates S if the user clicked OK in the dialog
if Length(trim(S.Text)) = 0 then
begin // there is no text, so free the stringlist to conserve memory
S.Free;
S := nil;
end;
JvTimeLine1.Objects[JvTimeLine1.SelDate] := S; // either way, store the value (nil or TStringlist)
// if Objects[JvTimeLine1.Date] has a non-nil value, the day number is underlined for that date
Ico.Free;
end;
// changes the widths of the scrollbuttons
procedure TTMTimeLineMainForm.udButtonWidthClick(Sender: TObject; Button: TUDBtnType);
begin
JvTimeLine1.ButtonWidth := udButtonWidth.Position;
StatusBarResize(Sender);
end;
// By default, the timeline only stores the imageindex for the dates so if you need
// a little more functionality, here's where you have your chance:
// The OnWriteObject event is called for any date that has a non-nil Objects.
// Because we are storing stringlists in the objects array, we save each of them as a
// long text string to the stream here.
// If you want to store other values, you will have to save them accordingly.
procedure TTMTimeLineMainForm.DoObjectSave(Sender:TObject;Stream:TStream;const AObject:TObject);
var S:string;Count:integer;
begin
S := TStringlist(AObject).Text;
Count := Length(S);
// save length of string
Stream.Write(Count,sizeof(Count));
// need we store anything ?
if Count > 0 then
Stream.Write(S[1],Count);
end;
// The OnReadObject event is called for each object stored in a data file.
// The Timeline keeps track of all the dates that have non-nil objects and calls
// this method for each one of them.
// You don't have to worry about the actual date the object belongs to, because the
// timeline handles this for you.
//
// You must do two things in this handler:
// 1. Create an instance of your class (if it is a class you are storing)
// 2. Read the data from the stream and save it in AObject
procedure TTMTimeLineMainForm.DoObjectLoad(Sender:TObject;Stream:TStream;var AObject:TObject);
var S:string;Count:integer;
begin
// Get the length of the string:
Stream.Read(Count,sizeof(Count));
SetLength(S,Count);
// need we read any more ?
if Count > 0 then
begin
Stream.Read(S[1],Count);
AObject := TStringlist.Create;
TStringlist(AObject).Text := S;
end;
end;
procedure TTMTimeLineMainForm.lbObjFontStyleClickCheck(Sender: TObject);
var F:TFontStyles;
begin
F := [];
with lbObjFontStyle do
begin
if Checked[0] then
Include(F,fsBold);
if Checked[1] then
Include(F,fsItalic);
if Checked[2] then
Include(F,fsUnderline);
if Checked[3] then
Include(F,fsStrikeOut);
end;
JvTimeLine1.ObjectsFontStyle := F;
end;
// move to the selected day and center it on the display
procedure TTMTimeLineMainForm.mnuGotoDateClick(Sender: TObject);
begin
JvTimeLine1.Date := JvTimeLine1.SelDate - JvTimeLine1.VisibleDays div 2;
end;
// update the statusbar whnever anything changes
procedure TTMTimeLineMainForm.StatusBarResize(Sender: TObject);
begin
StatusBar.Panels[0].Text := Format('Visible days: %d',[JvTimeLine1.VisibleDays]);
StatusBar.Panels[1].Text := Format('Last visible date: %s',[DateToStr(JvTimeLine1.LastVisibleDate)]);
end;
// display options:
procedure TTMTimeLineMainForm.chkShowMonthsClick(Sender: TObject);
begin
JvTimeLine1.ShowMonths := chkShowMonths.Checked;
end;
procedure TTMTimeLineMainForm.chkShowWeeksClick(Sender: TObject);
begin
JvTimeLine1.ShowWeeks := chkShowWeeks.Checked;
end;
procedure TTMTimeLineMainForm.chkShowTodayClick(Sender: TObject);
begin
JvTimeLine1.ShowToday := chkShowToday.Checked;
end;
// handling the wheel:
procedure TTMTimeLineMainForm.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
(* --------- FIX ME
if not JvTimeLine1.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then
begin
Handled := true;
if ssCtrl in Shift then
JvTimeLine1.ScrollDate(self,-udScrollSmall.Position)
else
JvTimeLine1.ScrollDate(self,-udScrollLarge.Position);
end;
*)
end;
procedure TTMTimeLineMainForm.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
begin
(* ---------- FIXME
if not JvTimeLine1.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then
begin
Handled := true;
if ssCtrl in Shift then
JvTimeLine1.ScrollDate(self,udScrollSmall.Position)
else
JvTimeLine1.ScrollDate(self,udScrollLarge.Position);
end;
*)
end;
procedure TTMTimeLineMainForm.btnLineColorClick(Sender: TObject);
begin
with TColorDialog.Create(nil) do
try
Color := JvTimeLine1.LineColor;
if Execute then
JvTimeLine1.LineColor := Color;
finally
Free;
end;
end;
procedure TTMTimeLineMainForm.chkShowTodayIconClick(Sender: TObject);
begin
JvTimeLine1.ShowTodayIcon := chkShowTodayIcon.Checked;
end;
end.

BIN
components/jvcllaz/examples/JvTMTimeLine/TeamManagerImages.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

103
components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.lfm Normal file
View File

@ -0,0 +1,103 @@
object MemoEditFrm: TMemoEditFrm
Left = 427
Height = 305
Top = 205
Width = 305
ActiveControl = reLines
BorderStyle = bsSizeToolWin
Caption = 'Memo for %s'
ClientHeight = 305
ClientWidth = 305
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
LCLVersion = '1.9.0.0'
object Panel1: TPanel
Left = 0
Height = 41
Top = 264
Width = 305
Align = alBottom
BevelOuter = bvNone
ClientHeight = 41
ClientWidth = 305
Font.Color = clWindowText
ParentFont = False
TabOrder = 0
object btnOK: TButton
Left = 137
Height = 25
Top = 8
Width = 75
Anchors = [akRight, akBottom]
Caption = '&OK'
Default = True
ModalResult = 1
TabOrder = 0
end
object btnCancel: TButton
Left = 217
Height = 25
Top = 8
Width = 75
Anchors = [akRight, akBottom]
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 1
end
end
object reLines: TMemo
Left = 4
Height = 256
Top = 4
Width = 297
Align = alClient
BorderSpacing.Around = 4
OnKeyUp = reLinesKeyUp
PopupMenu = popMemo
ScrollBars = ssBoth
TabOrder = 1
end
object popMemo: TPopupMenu
left = 128
top = 104
object Load1: TMenuItem
Caption = 'Load...'
ShortCut = 16463
OnClick = Load1Click
end
object Save1: TMenuItem
Caption = 'Save...'
ShortCut = 16467
OnClick = Save1Click
end
object N1: TMenuItem
Caption = '-'
end
object Cut1: TMenuItem
Caption = 'Cut'
ShortCut = 16472
OnClick = Cut1Click
end
object Copy1: TMenuItem
Caption = 'Copy'
ShortCut = 16451
OnClick = Copy1Click
end
object Paste1: TMenuItem
Caption = 'Paste'
ShortCut = 16470
OnClick = Paste1Click
end
object N2: TMenuItem
Caption = '-'
end
object Selectall1: TMenuItem
Caption = 'Select all'
ShortCut = 16449
OnClick = Selectall1Click
end
end
end

136
components/jvcllaz/examples/JvTMTimeLine/frmMemoEdit.pas Normal file
View File

@ -0,0 +1,136 @@
{******************************************************************
JEDI-VCL Demo
Copyright (C) 2002 Project JEDI
Original author:
Contributor(s):
You may retrieve the latest version of this file at the JEDI-JVCL
home page, located at http://jvcl.delphi-jedi.org
The contents of this file are used with permission, subject to
the Mozilla Public License Version 1.1 (the "License"); you may
not use this file except in compliance with the License. You may
obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1_1Final.html
Software distributed under the License is distributed on an
"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
******************************************************************}
{$mode objfpc}{$H+}
unit frmMemoEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, Menus;
type
TMemoEditFrm = class(TForm)
Panel1: TPanel;
btnOK: TButton;
btnCancel: TButton;
reLines: TMemo; //RichEdit;
popMemo: TPopupMenu;
Load1: TMenuItem;
Save1: TMenuItem;
N1: TMenuItem;
Cut1: TMenuItem;
Copy1: TMenuItem;
Paste1: TMenuItem;
Selectall1: TMenuItem;
N2: TMenuItem;
procedure Load1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Cut1Click(Sender: TObject);
procedure Copy1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure Selectall1Click(Sender: TObject);
procedure reLinesKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
public
class function Edit(Lines: TStrings;ADate:TDateTime; AIcon:TIcon = nil): boolean;
end;
implementation
{$R *.lfm}
{ TMemoEditFrm }
class function TMemoEditFrm.Edit(Lines: TStrings;ADate:TDateTime; AIcon:TIcon = nil): boolean;
var
f:TMemoEditFrm;
begin
f := self.Create(nil);
try
f.Icon := AIcon;
f.Caption := Format(f.Caption,[DateToStr(ADate)]);
f.reLines.Lines := Lines;
Result := f.ShowModal = MROK;
if Result then
Lines.Assign(f.ReLines.Lines);
finally
f.Free;
end;
end;
procedure TMemoEditFrm.Load1Click(Sender: TObject);
begin
with TOpenDialog.Create(nil) do
try
if Execute then
reLines.Lines.LoadFromFile(Filename);
finally
Free;
end;
end;
procedure TMemoEditFrm.Save1Click(Sender: TObject);
begin
with TSaveDialog.Create(nil) do
try
if Execute then
reLines.Lines.SaveToFile(Filename);
finally
Free;
end;
end;
procedure TMemoEditFrm.Cut1Click(Sender: TObject);
begin
reLines.CutToClipboard;
end;
procedure TMemoEditFrm.Copy1Click(Sender: TObject);
begin
reLines.CopyToClipboard;
end;
procedure TMemoEditFrm.Paste1Click(Sender: TObject);
begin
reLines.PasteFromClipboard;
end;
procedure TMemoEditFrm.Selectall1Click(Sender: TObject);
begin
reLines.SelectAll;
end;
procedure TMemoEditFrm.reLinesKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_ESCAPE then
Close;
end;
end.

BIN
components/jvcllaz/examples/JvTMTimeLine/il16.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.1 KiB

BIN
components/jvcllaz/resource/JvTMTimeLine.res Normal file
View File

Binary file not shown.

BIN
components/jvcllaz/resource/jvcustomreg.res
View File

Binary file not shown.

1368
components/jvcllaz/run/JvCustomControls/JvTMTimeLine.pas Normal file
View File

File diff suppressed because it is too large Load Diff