jvqyeargrid.pas

East make Tray Icon in delphi

var
  MonthIndex, DayIndex, Index: Integer;
  YList, DList: TStringList;
  S: string;
begin
  YList := TStringList.Create;
  DList := TStringList.Create;
  if FileName = '' then
    YList.LoadFromFile(FYearFile)
  else
    YList.LoadFromFile(FileName);

  Index := 0;
  for MonthIndex := 0 to 12 do
  begin
    for DayIndex := 0 to 37 do
    begin
      DList.CommaText := YList[Index];
      Inc(Index);
      FYearData[DayIndex, MonthIndex].DisplayText := DList[0];
      S := DList[1];
      S := StringReplace(S, '||', Cr, [rfReplaceAll]);
      FYearData[DayIndex, MonthIndex].InfoText := S;
      FYearData[DayIndex, MonthIndex].DefaultColor := StringToColor(DList[2]);
      FYearData[DayIndex, MonthIndex].CustomColor := StringToColor(DList[3]);
      FYearData[DayIndex, MonthIndex].Custom := (DList[4] = 'true');
    end;
  end;
  DList.Free;
  YList.Free;
  Invalidate;
end;

procedure TJvYearGrid.SetupYearData;
var
  S, D: string;
  DayOfWeekIndex, DayIndex, MonthIndex: Integer;
  AColor: TColor;
begin
  SetupMonths;
  for MonthIndex := 0 to 12 do
    for DayIndex := 0 to 37 do
    begin
      S := '';
      if DayIndex > 0 then
      begin
        // This gives a value from 1 to 7, with 1 being the first day
        // of the week.
        DayOfWeekIndex := ((DayIndex - 1) mod 7) + 1;

        // As ShortDayNames considers the first day to be a Sunday,
        // we have to offset the value of DayOfTheWeekIndex to match the
        // desired first day of the week
        Inc(DayOfWeekIndex, Integer(FFirstDayOfWeek)+1);
        If DayOfWeekIndex > 7 then
          DayOfWeekIndex := DayOfWeekIndex - 7;
        D := ShortDayNames[DayOfWeekIndex][1];
      end;

      // By default, there is no day in the current cell
      FYearData[DayIndex, MonthIndex].DayInMonth := 0;

      if (MonthIndex = 0) and (DayIndex = 0) then
        S := IntToStr(Year);
      if (MonthIndex = 0) and (DayIndex > 0) then
        S := D;
      if (MonthIndex <> 0) and (DayIndex = 0) then
        S := LongMonthNames[MonthIndex];
      if (MonthIndex <> 0) and (DayIndex > 0) then
      begin
        if (DayIndex >= StartDays[MonthIndex]) and (DayIndex < StartDays[MonthIndex] + DaysInMonth[MonthIndex]) then
        begin
          FYearData[DayIndex, MonthIndex].DayInMonth := DayIndex - StartDays[MonthIndex] + 1;
          S := IntToStr(FYearData[DayIndex, MonthIndex].DayInMonth);
        end;
      end;

      // AColor might have not been initialized with the following code.
      //if ((ACol>0)and (D='S')) then
      //  AColor:=clsilver;
      //if ((ACol>0)and (D<>'S')) then
      //  AColor:=clwhite;
      //  Change to:
      if (DayIndex > 0) and (D = 'S') then
        AColor := clSilver
      else
        AColor := clWhite;
      FYearData[DayIndex, MonthIndex].DisplayText := S;
      FYearData[DayIndex, MonthIndex].InfoText := '';
      FYearData[DayIndex, MonthIndex].DefaultColor := AColor;
      FYearData[DayIndex, MonthIndex].CustomColor := AColor;
      FYearData[DayIndex, MonthIndex].Custom := False;
      FYearData[DayIndex, MonthIndex].BookMark := False;
    end;
  AdjustBounds;
  Invalidate;
end;

procedure TJvYearGrid.ClearBookMarks;
var
  ACol, ARow: Integer;
  Cleared: Boolean;
begin
  Cleared := False;
  for ARow := 0 to 12 do
    for ACol := 0 to 37 do
    begin
      Cleared := Cleared or FYearData[ACol, ARow].BookMark;
      FYearData[ACol, ARow].BookMark := False;
    end;
  if Cleared then
    Invalidate;
end;

procedure TJvYearGrid.SetupMonths;
var
  AYear, AMonth, ADay: Word;
  ADate: TDate;
  I: Integer;
begin
  for I := 1 to 12 do
  begin
    AYear := Self.Year;
    AMonth := I + 1;
    if AMonth = 13 then
    begin
      AYear := AYear + 1;
      AMonth := 1;
    end;
    ADay := 1;
    ADate := EncodeDate(AYear, AMonth, ADay);
    ADate := ADate - 1;
    DecodeDate(ADate, AYear, AMonth, ADay);
    DaysInMonth[I] := ADay;
    AYear := Self.Year;
    AMonth := I;
    ADay := 1;
    ADate := EncodeDate(AYear, AMonth, ADay);
    StartDays[I] := DayOfWeek(ADate);
    Dec(StartDays[I], Integer(FFirstDayOfWeek)+1);
    If StartDays[I] < 1 then
      StartDays[I] := StartDays[I] + 7;
  end;
end;

function TJvYearGrid.GetCellData(var S: string): Boolean;
var
  ACol, ARow: Integer;
begin
  ACol := Col;
  ARow := Row;
  Result := False;
  if (ACol > 0) and (ARow > 0) then
    if FYearData[ACol, ARow].DisplayText <> '' then
    begin
      S := FYearData[ACol, ARow].InfoText;
      Result := True;
    end;
end;

function TJvYearGrid.SetCellData(S: string): Boolean;
var
  ACol, ARow: Integer;
begin
  ACol := Col;
  ARow := Row;
  Result := False;
  if (ACol > 0) and (ARow > 0) then
    if FYearData[ACol, ARow].DisplayText <> '' then
    begin
      FYearData[ACol, ARow].InfoText := S;
      Result := True;
    end;
end;

procedure TJvYearGrid.Copy1Click(Sender: TObject);
var
  S: string;
begin
  if GetCellData(S) then
    Clipboard.AsText := S;
end;

procedure TJvYearGrid.Cut1Click(Sender: TObject);
var
  S: string;
begin
  if GetCellData(S) then
  begin
    Clipboard.AsText := S;
    SetCellData('');
  end;
end;

procedure TJvYearGrid.Year1Click(Sender: TObject);
var
  S: string;
  AYear: Word;
begin
  S := InputBox(RsYearGrid, RsEnterYear, IntToStr(Self.Year));
  try
    if S = '' then
      Exit;
    AYear := StrToInt(S);
    if (AYear < 1999) or (AYear > 2050) then
      Exit;
    Self.Year := AYear;
  except
    ShowMessage(RsInvalidYear);
  end;
end;

procedure TJvYearGrid.Paste1Click(Sender: TObject);
var
  S: string;
begin
  if GetCellData(S) then  
    if Clipboard.AsText <> '' then 
      SetCellData(Clipboard.AsText);
end;

procedure TJvYearGrid.Delete1Click(Sender: TObject);
var
  S: string;
begin
  if GetCellData(S) then
    SetCellData('');
end;

procedure TJvYearGrid.CreatePopup;
const
  cMenuBreakCaption = '-';
var
  G: TPopupMenu;
  M: TMenuItem;
begin
  FGridPop := TPopupMenu.Create(Self);
  G := FGridPop;
  M := TMenuItem.Create(G);
  M.Caption := RsYear;
  M.OnClick := Year1Click;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := cMenuBreakCaption;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsEdit;
  M.OnClick := Edit1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsColor;
  M.OnClick := Color1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsNoColor;
  M.OnClick := NoColor1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := cMenuBreakCaption;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsCopyItem;
  M.OnClick := Copy1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsCutItem;
  M.OnClick := Cut1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsPasteItem;
  M.OnClick := Paste1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsDeleteItem;
  M.OnClick := Delete1Click;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := cMenuBreakCaption;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsSaveAllInfo;
  M.OnClick := SaveAsHTML;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsSaveFoundInfo;
  M.OnClick := SaveFound;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := cMenuBreakCaption;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsBorderColor;
  M.OnClick := BorderColor1Click;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsBookMarkColor;
  M.OnClick := BookMarkColor1Click;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := cMenuBreakCaption;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsFindItem;
  M.OnClick := Find1Click;
  M.Tag := 1;
  G.Items.Add(M);
  M := TMenuItem.Create(G);
  M.Caption := RsClearFind;
  M.OnClick := ClearFind1Click;
  M.Tag := 1;
  G.Items.Add(M);
end;

procedure TJvYearGrid.Edit1Click(Sender: TObject);
var
  DS: string;
  ACol, ARow: Integer;
  F: TYearGridEditForm;
  CanChange: Boolean;
  InfoText: string;
begin
  ACol := Col;
  ARow := Row;
  if (ACol < 1) or (ARow < 1) then
    Exit;
  DS := FYearData[Col, Row].DisplayText;
  if DS = '' then
    Exit;
  F := TYearGridEditForm.Create(Application);
  InfoText := FYearData[ACol, ARow].InfoText;
  F.MemoText.Text := InfoText;
  if F.ShowModal = mrOk then
  begin
    InfoText := F.MemoText.Text;
    CanChange := True;
    if Assigned(FOnInfoChanging) then
      FOnInfoChanging(Self, InfoText, CanChange);
    if CanChange then
    begin
      FYearData[Col, Row].InfoText := InfoText;
      if InfoText = '' then
        FYearData[Col, Row].Custom := False
      else
      if not FYearData[Col, Row].Custom then
      begin
        FYearData[Col, Row].Custom := True;
        FYearData[Col, Row].CustomColor := RGB(206, 250, 253);
      end;
    end;
  end;
  F.Free;
end;

procedure TJvYearGrid.Color1Click(Sender: TObject);
var
  CD: TColorDialog;
begin
  if (Col < 1) or (Row < 1) or (FYearData[Col, Row].DisplayText = '') then
    Exit;
  CD := TColorDialog.Create(Application); 
  if CD.Execute then
  begin
    FYearData[Col, Row].CustomColor := CD.Color;
    FYearData[Col, Row].Custom := True;
    Invalidate;
  end;
  CD.Free;
end;

procedure TJvYearGrid.NoColor1Click(Sender: TObject);
begin
  if (Col < 1) or (Row < 1) or (FYearData[Col, Row].DisplayText = '') then
    Exit;
  FYearData[Col, Row].Custom := False;
  Invalidate;
end;

procedure TJvYearGrid.SetupGridPop(Sender: TObject);
var
  I: Integer;
begin
  if (Col > 0) and (Row > 0) and (FYearData[Col, Row].DisplayText <> '') then
    for I := 0 to FGridPop.Items.Count - 1 do
      FGridPop.Items[I].Enabled := True
  else
    for I := 0 to FGridPop.Items.Count - 1 do
      FGridPop.Items[I].Enabled := (FGridPop.Items[I].Tag = 1);
end;

procedure TJvYearGrid.Launch(AFile: string);
var
  Command, Params, WorkDir: string;
begin
  Command := AFile;
  Params := '';
  WorkDir := '';  
  ShellExecute(HWND_DESKTOP, 'open', PChar(Command),
    PChar(Params), PChar(WorkDir), SW_SHOWNORMAL); 
end;

procedure TJvYearGrid.SetHTMLFontName(const Value: string);
begin
  FHTMLFontName := Value;
end;

function TJvYearGrid.GetSelDateText: string;
var
  DS: string;
begin
  if (Col < 1) or (Row < 1) then
    Exit;
  DS := FYearData[Col, Row].DisplayText;
  if DS = '' then
    Exit;
  Result := FYearData[Col, Row].InfoText;
end;

procedure TJvYearGrid.SetSelDateText(AText: string);
var
  DS, S: string;
begin
  if (Col < 1) or (Row < 1) then
    Exit;
  DS := FYearData[Col, Row].DisplayText;
  if DS = '' then
    Exit;
  FYearData[Col, Row].InfoText := S;
end;

procedure TJvYearGrid.SetSelectDate(const Value: TOnSelectDate);
begin
  FOnSelectDate := Value;
end;

function TJvYearGrid.SelectCell(ACol, ARow: Longint): Boolean;
var
  DS: string;
  ADate: TDate;
  InfoText: string;
  InfoColor: TColor;
//  Month, Day: Word;
  MonthIndex, DayIndex: Integer;
  CanSelect: Boolean;
begin
  CanSelect := True;
  if Assigned(OnSelectCell) then
    OnSelectCell(Self, ACol, ARow, CanSelect);
  if not CanSelect then
  begin
    Result := False;
    Exit;
  end;
  Result := False;
  if (ACol < 1) or (ARow < 1) then
    Exit;

  ColRowToDayMonthIndex(ACol, ARow, DayIndex, MonthIndex);  

  DS := FYearData[DayIndex, MonthIndex].DisplayText;
  if DS = '' then
    Exit;
//  Month := ARow;
//  Day := StrToInt(FYearData[ACol, ARow].DisplayText);
  ADate := EncodeDate(Year, MonthIndex, FYearData[DayIndex, MonthIndex].DayInMonth);
  InfoText := FYearData[DayIndex, MonthIndex].InfoText;
  if FYearData[DayIndex, MonthIndex].Custom then
    InfoColor := FYearData[DayIndex, MonthIndex].CustomColor
  else
    InfoColor := FYearData[DayIndex, MonthIndex].DefaultColor;
  if Assigned(FOnSelectDate) then
    FOnSelectDate(Self, ADate, InfoText, InfoColor);
  Result := True;
end;

procedure TJvYearGrid.DblClick;
begin
  if Assigned(OnDblClick) then
    OnDblClick(Self)
  else
    if (Col > 0) and (Row > 0) and (FYearData[Col, Row].DisplayText <> '') then
      Edit1Click(nil);
end;

procedure TJvYearGrid.SetBorderColor(const Value: TColor);
begin
  if Value <> FBorderColor then
  begin
    FBorderColor := Value;
    Invalidate;
  end;
end;

procedure TJvYearGrid.BorderColor1Click(Sender: TObject);
var
  CD: TColorDialog;
begin
  CD := TColorDialog.Create(Application); 
  if CD.Execute then
    BorderColor := CD.Color;
  CD.Free;
end;

procedure TJvYearGrid.BookMarkColor1Click(Sender: TObject);
var
  CD: TColorDialog;
begin
  CD := TColorDialog.Create(Application); 
  if CD.Execute then
    BookMarkColor := CD.Color;
  CD.Free;
end;

procedure TJvYearGrid.SetInfoChanging(const Value: TOnInfoChanging);
begin
  FOnInfoChanging := Value;
end;

function TJvYearGrid.DateToCell(ADate: TDate; var ACol, ARow: Integer): Boolean;