jvqtimeline.pas

East make Tray Icon in delphi

  ShiftState := []; // TODO: detect shift state on CLX 

  ScrollCode := GetScrollCode(ssCtrl in ShiftState);
  TimeLine.FLastScrollCode := ScrollCode;
  case Direction of
    scrollLeft:
      begin
        if ssCtrl in ShiftState then
          TimeLine.PrevYear
        else
          TimeLine.PrevMonth;
        ScrollPos := Trunc(TimeLine.FirstVisibleDate);
        TimeLine.HorzScroll(ScrollCode, ScrollPos);
        TimeLine.SetFirstDate(ScrollPos);
      end;
    scrollRight:
      begin
        if ssCtrl in ShiftState then
          TimeLine.NextYear
        else
          TimeLine.NextMonth;
        ScrollPos := Trunc(TimeLine.FirstVisibleDate);
        TimeLine.HorzScroll(ScrollCode, ScrollPos);
        TimeLine.SetFirstDate(ScrollPos);
      end;
    scrollUp:
      begin
        if TimeLine.FTopLevel > 0 then
          ScrollPos := TimeLine.FTopLevel - 1;
        TimeLine.VertScroll(ScrollCode, ScrollPos);
        if ScrollPos >= 0 then
          TimeLine.SetTopLevel(ScrollPos);
      end;
    scrollDown:
      begin
        ScrollPos := TimeLine.FTopLevel + 1;
        TimeLine.VertScroll(ScrollCode, ScrollPos);
        if (ScrollPos >= 0) then
          TimeLine.SetTopLevel(ScrollPos);
      end;
  end;
  if TimeLine.CanFocus then
    TimeLine.SetFocus;
  inherited;
end;

procedure TJvTLScrollBtn.OnTimer(Sender: TObject);
begin
  FTimer.Interval := FRepeatPause;
  if FPushed and MouseCapture then
  try
    Click;
  except
    FTimer.Enabled := False;
    raise;
  end;
end;

//=== { TJvCustomTimeLine } ==================================================

constructor TJvCustomTimeLine.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  FStates := [];
  FOldX := -1;

  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
  FCanvas.Pen.Color := clBlack;
  FCanvas.Pen.Mode := pmNotXor;
  FCanvas.Pen.Style := psDot;

  Bmp := TBitmap.Create;
  FItemHintImageList := TImageList.CreateSize(14, 6);
  try
    Bmp.LoadFromResourceName(HInstance, 'JvCustomTimeLineITEMLEFT');
    FItemHintImageList.Add(Bmp, nil);
    Bmp.LoadFromResourceName(HInstance, 'JvCustomTimeLineITEMRIGHT');
    FItemHintImageList.Add(Bmp, nil);
  finally
    Bmp.Free;
  end;
  FSupportsColor := clBtnFace;
  DoubleBuffered := True;
  FBmp := TBitmap.Create;
  FList := TList.Create;
  FHelperYears := True;
  ControlStyle := [csOpaque, csClickEvents, csDoubleClicks,
    csCaptureMouse, csDisplayDragImage];
  FBorderStyle := bsSingle;
  Color := clWhite;
  FYearList := TList.Create;
  FScrollArrows := [scrollLeft..scrollDown];
  FSupportLines := False;
  FTopOffset := 21;
  FShowDays := False;
  FItemHeight := 12;
  FTopLevel := 0;
  FStyle := tlDefault;
  FShowItemHint := False;
  FShowHiddenItemHints := True;
  FFlat := False;
  FYearWidth := 140;
  FMonthWidth := 12;
  FMultiSelect := False;
  FDragLine := True;
  FTimeItems := TJvTimeItems.Create(Self);
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImagesChanged;
  FYearFont := TFont.Create;
  FYearFont.Size := 18;
  FYearFont.OnChange := DoYearFontChange;
  FNewHeight := 0;
  FAutoSize := False;
  FScrollWidth := GetSystemMetrics(SM_CXHSCROLL);
  FScrollHeight := GetSystemMetrics(SM_CXVSCROLL);
  UpdateOffset;
  Align := alTop;
  Height := 120;
  SetFirstDate(Date);
end;

destructor TJvCustomTimeLine.Destroy;
begin 
  FCanvas.Free;
  FYearList.Free;
  FBmp.Free;
  FList.Free;
  FTimeItems.Free;
  FImageChangeLink.Free;
  FYearFont.Free;
  FItemHintImageList.Free;
  inherited Destroy;
end;
procedure TJvCustomTimeLine.DoYearFontChange(Sender: TObject);
begin
  Invalidate;
end;




procedure TJvCustomTimeLine.CreateWidget;
var
  I: TJvScrollArrow;
begin
  inherited;
  for I := Low(TJvScrollArrow) to High(TJvScrollArrow) do
  begin
    if FArrows[I] = nil then
    begin
      FArrows[I] := TJvTLScrollBtn.Create(Self);
      FArrows[I].Parent := Self;
      FArrows[I].TimeLine := Self;
      FArrows[I].Height := FScrollHeight;
      FArrows[I].Width := FScrollWidth;
      FArrows[I].Direction := I;
      FArrows[I].RepeatClick := I in [scrollLeft, scrollRight];
    end
    else
      FArrows[I].UpdatePlacement;
  end;
end;


procedure TJvCustomTimeLine.UpdateOffset;
begin
  FItemOffset := FTopOffset + FYearTextTop + Abs(FYearFont.Height) * 2;
end;

procedure TJvCustomTimeLine.SetHelperYears(Value: Boolean);
begin
  if FHelperYears <> Value then
  begin
    FHelperYears := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetFlat(Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetScrollArrows(Value: TJvScrollArrows);
begin
  if FScrollArrows <> Value then
  begin
    FScrollArrows := Value;
    DrawScrollButtons;
  end;
end;

procedure TJvCustomTimeLine.DrawScrollButtons;
var
  I: TJvScrollArrow;
begin
  if FArrows[scrollLeft] = nil then
    Exit;
  for I := Low(TJvScrollArrow) to High(TJvScrollArrow) do
    FArrows[I].Flat := Flat;
  FArrows[scrollLeft].Visible := scrollLeft in ScrollArrows;
  FArrows[scrollRight].Visible := scrollRight in ScrollArrows;
  FArrows[scrollUp].Visible :=
    (scrollUp in ScrollArrows) and (FTopLevel > 0);
  FArrows[scrollDown].Visible :=
    (scrollDown in ScrollArrows) and (FNewHeight >= Height) ;
end;

procedure TJvCustomTimeLine.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;


procedure TJvCustomTimeLine.SetTopLevel(Value: Integer);
begin
  if FTopLevel <> Value then
  begin
    FTopLevel := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetTopOffset(Value: Integer);
begin
  if FTopOffset <> Value then
  begin
    FTopOffset := Value;
    UpdateOffset;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetMultiSelect(Value: Boolean);
begin
  if FMultiSelect <> Value then
  begin
    FMultiSelect := Value;
    if not FMultiSelect then
      HighLiteItem(Selected);
  end;
end;

procedure TJvCustomTimeLine.SetYearFont(Value: TFont);
begin
  FYearFont.Assign(Value);
  UpdateOffset;
  //  Invalidate;
end;

procedure TJvCustomTimeLine.SetYearWidth(Value: TJvYearWidth);
begin
  if FYearWidth <> Value then
  begin
    FYearWidth := Value;
    FMonthWidth := FYearWidth / 12;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetFirstDate(Value: TDate);
var
  Y, M, D: Word;
begin
  DecodeDate(Value, Y, M, D);
  Value := EncodeDate(Y, M, 1);
  if Trunc(FFirstDate) <> Trunc(Value) then
  begin
    FFirstDate := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetTimeItems(Value: TJvTimeItems);
begin
  FTimeItems.Assign(Value);
end;

procedure TJvCustomTimeLine.SetImages(Value: TCustomImageList);
begin
  if FImages <> Value then
  begin
    if FImages <> nil then
    begin
      FImages.RemoveFreeNotification(Self);
      FImages.UnRegisterChanges(FImageChangeLink);
    end;
    FImages := Value;
    if FImages <> nil then
    begin
      FImages.FreeNotification(Self);
      FImages.RegisterChanges(FImageChangeLink);
    end;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetSelectedItem(Value: TJvTimeItem);
begin
  if FSelectedItem <> Value then
  begin
    if Value <> nil then
      Value.Selected := True;
    UpdateItems;
  end;
end;

procedure TJvCustomTimeLine.SetStyle(Value: TJvTimeLineStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetItemHeight(Value: Integer);
begin
  if FItemHeight <> Value then
  begin
    FItemHeight := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetShowMonths(Value: Boolean);
begin
  if FShowMonths <> Value then
  begin
    FShowMonths := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetShowDays(Value: Boolean);
begin
  if FShowDays <> Value then
  begin
    FShowDays := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.SetSupportLines(Value: Boolean);
begin
  if FSupportLines <> Value then
  begin
    FSupportLines := Value;
    Invalidate;
  end;
end;

procedure TJvCustomTimeLine.ImagesChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TJvCustomTimeLine.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FImages) then
    Images := nil;
end;

procedure TJvCustomTimeLine.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  // Copied a lot from (Mike Linschke's) virtualtree.
  // Some stuff maybe unnecessairy or overkill/wrong.

    IsHit, // the node's caption or images are hit
    ItemSelected, // the new node (if any) is selected
    ShiftEmpty: Boolean; // ShiftState = []
  ShiftState: TShiftState;
  LastSelected: TJvTimeItem;
  LSelectedItem: TJvTimeItem;
begin
  //OutputDebugString('MouseDown');
  if Button = mbLeft then
    Include(FStates, tlMouseDown);

  // Get the currently focused node to make multiple multi-selection blocks possible.
  LastSelected := FSelectedItem;
  ShiftState := Shift * [ssCtrl, ssShift];
  ShiftEmpty := ShiftState = [];
  FAutoDrag := (DragMode = dmAutomatic) or Dragging;
  LSelectedItem := ItemAtPos(X, Y);
  IsHit := Assigned(LSelectedItem);
  ItemSelected := IsHit; // and LSelectedItem.Selected;

  if ItemSelected and ItemMoving(LSelectedItem) then
  begin
    FStartPos := Point(X, Y);
    FLineVisible := True;
  end
  else
    LSelectedItem := nil;

  // pending clearance
  if MultiSelect and ShiftEmpty and IsHit and FAutoDrag then
    Include(FStates, tlClearPending);


  if (not IsHit and MultiSelect and ShiftEmpty) or
    (IsHit and (ShiftEmpty or not MultiSelect)) then
  begin
    if ItemSelected then
    begin
      ClearSelection;
      AddToSelection(LSelectedItem);
    end
    else
      ClearSelection;
  end;

  // focus change
  if not Focused and CanFocus then
    SetFocus;

  // Handle selection and node focus change.
  if IsHit then
  begin
    if MultiSelect and not Dragging and not ShiftEmpty then
      HandleClickSelection(LastSelected, LSelectedItem, ShiftState)
    else
    begin
      if ShiftEmpty then
        FRangeAnchor := LSelectedItem;

      // If the hit node is not yet selected then do it now.
      if not ItemSelected then
        AddToSelection(LSelectedItem);
    end;

    // Drag'n drop initiation
    // If we lost focus in the interim the button states would be cleared in WM_KILLFOCUS.
    if FAutoDrag then
      BeginDrag(False);
  end;

  inherited MouseDown(Button, Shift, X, Y);

  if (Dragging or FAutoDrag) and FLineVisible and (tlMouseDown in FStates) and
    not (tlDragPending in FStates) then
    MoveDragLine(X);
end;

function TJvCustomTimeLine.HasMoved(P: TPoint): Boolean;
begin
  Result := FAutoDrag or Dragging and ((Abs(FStartPos.X - P.X) > 10) or (Abs(FStartPos.Y - P.Y) > ItemHeight div 2));
end;