tmtimelinemainformu.pas

East make Tray Icon in delphi

// 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
  sl.ReadOnly := chkReadOnly.Checked;
  StatusBarResize(Sender);
end;

// enabled is not the same as read-only!
procedure TTMTimeLineMainForm.chkEnabledClick(Sender: TObject);
begin
  sl.Enabled := chkEnabled.Checked;
end;

// DayWidth is simply the width in pixels for one day
procedure TTMTimeLineMainForm.udDayWidthClick(Sender: TObject; Button: TUDBtnType);
begin
  sl.DayWidth := udDayWidth.Position;
  udDayWidth.Position := sl.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 := sl.Color;
    if Execute then
      sl.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
  sl.BorderStyle := cBStyle[chkFlat.Checked];
end;

// update the first visible date from the datetimepicker
procedure TTMTimeLineMainForm.dtpFirstDateChange(Sender: TObject);
begin
  sl.Date := dtpFirstDate.Date;
end;

// update the selected date from the datetimepicker
procedure TTMTimeLineMainForm.dtpSelDateChange(Sender: TObject);
begin
  sl.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 := sl.Selection.Pen.Color;
    if Execute then
    begin
      sl.Selection.Pen.Color := Color;
    end;
  finally
    Free;
  end;
end;

// change the Selection frame Pen's width
procedure TTMTimeLineMainForm.udPenWidthClick(Sender: TObject; Button: TUDBtnType);
begin
  sl.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 := sl.TodayColor;
    if Execute then
      sl.TodayColor := Color;
  finally
    Free;
  end;
end;

// when RightClickSelect is true, a right-click changes
// the TJvTLTimeline.Date value
procedure TTMTimeLineMainForm.chkRClickClick(Sender: TObject);
begin
  sl.RightClickSelect := chkRClick.Checked;
end;

// move today to the middle of the timeline; looks better
procedure TTMTimeLineMainForm.mnuTodayClick(Sender: TObject);
begin
  sl.Date := Date - sl.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
  sl.ImageIndex[sl.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
  sl.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
  sl.LargeChange := udScrollLarge.Position;
end;

// remove an image by setting the imageindex to -1
procedure TTMTimeLineMainForm.mnuRemoveImageClick(Sender: TObject);
begin
  sl.ImageIndex[sl.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;
  Bmp: TBitmap;
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:
//  sl.Objects[sl.Date] := TObject(Random(100));

  S := TStringlist(sl.Objects[sl.SelDate]);
  // here's a trick: extract the image from the imagelist and assign t to the icon property of the form:
  i := sl.ImageIndex[sl.SelDate];
  if i > -1 then
  begin
    Ico := TIcon.Create;
    Bmp := TBitmap.Create;
    il16.GetBitmap(i, Bmp);
    Ico.Assign(Bmp);
    Bmp.Free;
  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,sl.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;
  sl.Objects[sl.SelDate] := S; // either way, store the value (nil or TStringlist)
  // if Objects[sl.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
  sl.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;
  sl.ObjectsFontStyle := F;
end;

// move to the selected day and center it on the display
procedure TTMTimeLineMainForm.mnuGotoDateClick(Sender: TObject);
begin
  sl.Date := sl.SelDate - sl.VisibleDays div 2;
end;

// update the statusbar whnever anything changes
procedure TTMTimeLineMainForm.StatusBarResize(Sender: TObject);
begin
  if not assigned(sl) then
    exit;
  StatusBar.Panels[0].Text := Format('Visible days: %d',[sl.VisibleDays]);
  StatusBar.Panels[1].Text := Format('Last visible date: %s',[DateToStr(sl.LastVisibleDate)]);
end;

// display options:
procedure TTMTimeLineMainForm.chkShowMonthsClick(Sender: TObject);
begin
  sl.ShowMonths := chkShowMonths.Checked;
end;

procedure TTMTimeLineMainForm.chkShowWeeksClick(Sender: TObject);
begin
  sl.ShowWeeks := chkShowWeeks.Checked;
end;

procedure TTMTimeLineMainForm.chkShowTodayClick(Sender: TObject);
begin
  sl.ShowToday := chkShowToday.Checked;
end;

// handling the wheel:
procedure TTMTimeLineMainForm.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if  not sl.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then
  begin
    Handled := true;
    if ssCtrl in Shift then
      sl.ScrollDate(self,-udScrollSmall.Position)
    else
      sl.ScrollDate(self,-udScrollLarge.Position);
  end;
end;

procedure TTMTimeLineMainForm.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  if  not sl.Focused and (ControlAtPos(ScreenToClient(MousePos),false,true) is TJvTMTimeline) then
  begin
    Handled := true;
    if ssCtrl in Shift then
      sl.ScrollDate(self,udScrollSmall.Position)
    else
      sl.ScrollDate(self,udScrollLarge.Position);
  end;
end;

procedure TTMTimeLineMainForm.btnLineColorClick(Sender: TObject);
begin
  with TColorDialog.Create(nil) do
  try
    Color := sl.LineColor;
    if Execute then
      sl.LineColor := Color;
  finally
    Free;
  end;

end;

end.