tmtimelinemainformu.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
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鰎nqvist [peter3 att users dott sourceforge dott net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.
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.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit TMTimeLineMainFormU;
{
  This demo demonstrates the different properties, methods and events unique to
  the Team Manager Timeline.
}
interface

uses
  QWindows, QMessages, SysUtils, Classes, Types, QGraphics, QControls, QForms, QDialogs,
  QExtCtrls, QComCtrls, QStdCtrls, QButtons, QImgList,
  QMenus, QCheckLst, JvQTMTimeLine, QMask, QComboEdits, JvQExComboEdits,
  JvQToolEdit, QTypes, QComCtrlsEx;

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;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    edImageNo: TEdit;
    udImageNo: TUpDown;
    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;
    dtpFirstDate: TJvDateEdit;
    dtpSelDate: TJvDateEdit;
    dtpImageDate: TJvDateEdit;
    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);
  private
    { Private declarations }
    sl: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 *.xfm}

procedure TTMTimeLineMainForm.FormCreate(Sender: TObject);
var
  i : integer;
begin
//  ForceCurrentDirectory := true;
  sl              := TJvTMTimeline.Create(self);
  sl.Parent       := self;
  sl.PopUpMenu    := popTimeline;
  sl.OnChange     := DoDateChange;
  sl.OnClick      := DoClick;
  sl.OnDblClick   := DoDblClick;
  sl.Images       := il16;
  sl.Align        := alClient;
  sl.Hint         := 'Double-click a date to edit it''s memo content.'#13#10'Right-click to display pop-up menu.';
  dtpSelDate.Date     := Date;
  dtpFirstDate.Date   := Date-7;
  dtpImageDate.Date   := Date+7;
  udDayWidth.Position := sl.DayWidth;
  chkReadOnly.Checked := sl.ReadOnly;
  sl.Date := dtpFirstDate.Date;
  sl.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 := sl.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
  sl.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(0, 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
      sl.OnReadObject := DoObjectLoad;
      sl.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
      sl.OnWriteObject := DoObjectSave;
      sl.SaveToFile(Filename);
    end;
  finally
    Free;
  end;
end;

//****************************************************************************//

// set imageindex for the chosen date
procedure TTMTimeLineMainForm.btnAddClick(Sender: TObject);
begin
  sl.ImageIndex[dtpImageDate.Date] := 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 := sl.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 := sl.SelDate;
  dtpImageDate.Date := sl.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 := sl.Font;
    if Execute then
      sl.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 := sl.MonthFont;
    if Execute then
      sl.MonthFont := Font;
  finally
    Free;
  end;
end;