jvtimeline.pas

East make Tray Icon in delphi

        Button := TThemedScrollBar(Ord(tsArrowBtnUpNormal) + Ord(Button) - Ord(tsArrowBtnLeftNormal));
      scrollDown:
        Button := TThemedScrollBar(Ord(tsArrowBtnDownNormal) + Ord(Button) - Ord(tsArrowBtnLeftNormal));
    end;
    Details := ThemeServices.GetElementDetails(Button);
    ThemeServices.DrawElement(Canvas.Handle, Details, Rect(0, 0, Width, Height));
  end
  else
  {$ENDIF JVCLThemesEnabled}
    //  TimeLine.FSelectedItem := nil; { fixes begindrag bug ? }
    DrawFrameControl(Canvas.Handle, Rect(0, 0, Width, Height), DFC_SCROLL,
      CFlat[Flat] or CPushed[FPushed] or Directions[Direction]);
end;

procedure TJvTLScrollBtn.UpdatePlacement;
begin
  if TimeLine = nil then
    Exit;
  TimeLine.UpdateOffset;
  case FDirection of
    scrollLeft:
      begin
        SetBounds(FScrollEdgeOffset, TimeLine.Height - FScrollEdgeOffset -
          TimeLine.FScrollHeight,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akLeft, akBottom];
      end;
    scrollRight:
      begin
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth * 2,
          TimeLine.Height - FScrollEdgeOffset - TimeLine.FScrollHeight,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akBottom];
      end;
    scrollUp:
      begin
        Anchors := [];
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth,
          TimeLine.FItemOffset + FScrollEdgeOffset,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akTop];
      end;
    scrollDown:
      begin
        SetBounds(TimeLine.Width - FScrollEdgeOffset - TimeLine.FScrollWidth,
          TimeLine.Height - FScrollEdgeOffset - TimeLine.FScrollHeight * 2,
          TimeLine.FScrollWidth, TimeLine.FScrollHeight);
        Anchors := [akRight, akBottom];
      end;
  end;
end;

procedure TJvTLScrollBtn.SetDirection(const Value: TJvScrollArrow);
begin
  FDirection := Value;
  if (TimeLine <> nil) and (TimeLine.Parent <> nil )then
  begin
    UpdatePlacement;
    Invalidate;
  end;
end;

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

procedure TJvTLScrollBtn.SetTimeLine(const Value: TJvCustomTimeLine);
begin
  FTimeLine := Value;
  Invalidate;
end;

procedure TJvTLScrollBtn.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if RepeatClick then
  begin
    if FTimer = nil then
      FTimer := TTimer.Create(Self);

    FTimer.OnTimer := OnTimer;
    FTimer.Interval := FInitRepeatPause;
    FTimer.Enabled := True;
  end;
  FPushed := True;
  Invalidate;
  //  Click;
end;

procedure TJvTLScrollBtn.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  FPushed := False;
  Invalidate;
  if FTimer <> nil then
    FTimer.Enabled := False;
end;

procedure TJvTLScrollBtn.Click;
var
  ScrollPos: Integer;
  ScrollCode: TScrollCode;
  ShiftState: TShiftState;
  {$IFDEF VCL}
  KeyState: TKeyboardState;
  {$ENDIF VCL}

  function GetScrollCode(LargeChange: Boolean): TScrollCode;
  begin
    case Direction of
      scrollLeft:
        if LargeChange then
          Result := scPageUp
        else
          Result := scLineUp;
      scrollRight:
        if LargeChange then
          Result := scPageDown
        else
          Result := scLineDown;
      scrollUp: Result := scLineUp;
    else
      Result := scLineDown;
    end;
  end;

begin
  if TimeLine = nil then
    Exit;

  {$IFDEF VCL}
  GetKeyboardState(KeyState);
  ShiftState := KeyboardStateToShiftState(KeyState);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  ShiftState := []; // TODO: detect shift state on CLX
  {$ENDIF VisualCLX}

  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
  {$IFDEF VCL}
  FDragImages.Free;
  {$ENDIF VCL}
  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;

{$IFDEF VCL}
procedure TJvCustomTimeLine.CreateWnd;
var
  I: TJvScrollArrow;
begin
  inherited CreateWnd;
  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;
{$ENDIF VCL}

{$IFDEF VisualCLX}
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;
{$ENDIF VisualCLX}

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) {$IFDEF VCL} and not AutoSize {$ENDIF};
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;