{----------------------------------------------------------------------------- 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 Original Code is: JvYearGrid.PAS, released on 2002-06-15. The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. All Rights Reserved. Contributor(s): Robert Love [rlove at slcdug dot org]. Olivier Sannier [obones at users dot sourceforge dot net] 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: -----------------------------------------------------------------------------} // $Id: JvYearGrid.pas 10613 2006-05-19 19:21:43Z jfudickar $ unit JvYearGrid; {$I jvcl.inc} interface uses {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} JclUnitVersioning, {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} {$IFDEF MSWINDOWS} ShellAPI, {$ENDIF MSWINDOWS} Windows, Messages, Graphics, Controls, Forms, Dialogs, Grids, Menus, Clipbrd, {$IFDEF USEJVCL} JvJVCLUtils, JvTypes, {$ENDIF USEJVCL} SysUtils, StdCtrls, Classes; {$IFDEF VCL} {$IFDEF COMPILER6_UP} {$DEFINE USECUSTOMGRID} {$ENDIF COMPILER6_UP} {$ENDIF VCL} const JvDefaultBorderColor = TColor($EEF5FF); type {$IFNDEF USEJVCL} THintString = string; {$HPPEMIT '#ifndef TDate'} {$IFDEF VCL} {$HPPEMIT '#define TDate Controls::TDate'} {$HPPEMIT '#define TTime Controls::TTime'} {$ENDIF VCL} {$IFDEF VisualCLX} {$HPPEMIT '#define TDate TDateTime'} {$HPPEMIT '#define TTime TDateTime'} {$ENDIF VisualCLX} {$HPPEMIT '#endif'} {$ENDIF !USEJVCL} TYearData = record DisplayText: string; InfoText: string; DayInMonth: Integer; DefaultColor: TColor; CustomColor: TColor; Custom: Boolean; BookMark: Boolean; // this is not saved end; TJvYearGridOrientation = (yoHorizontal, yoVertical); TJvWeekDay = (wdMonday, wdTuesday, wdWednesday, wdThursday, wdFriday, wdSaturday, wdSunday); TJvWeekDaySet = set of TJvWeekDay; TJvAutoSizeOptions = set of (aoGrid, aoFirstColumn, aoFirstRow, aoColumns, aoRows); TOnYearChanged = procedure(Sender: TObject; AYear: Integer) of object; TOnSelectDate = procedure(Sender: TObject; ADate: TDate; InfoText: string; InfoColor: TColor) of object; TOnInfoChanging = procedure(Sender: TObject; var InfoText: string; var CanChange: Boolean) of object; {$IFDEF USECUSTOMGRID} TJvYearGrid = class(TCustomDrawGrid) {$ELSE} TJvYearGrid = class(TDrawGrid) {$ENDIF USECUSTOMGRID} private FGridPop: TPopupMenu; FCurrentYear: Word; FCurrentMonth: Word; FCurrentDay: Word; FHTMLBorder: Boolean; FOnYearChanged: TOnYearChanged; FHTMLFontName: string; FOnSelectDate: TOnSelectDate; FBorderColor: TColor; FOnInfoChanging: TOnInfoChanging; FBookMarkColor: TColor; FAutoSize: Boolean; DaysInMonth: array [1..12] of Integer; StartDays: array [1..12] of Integer; FYearData: array [0..37, 0..12] of TYearData; FYearFile: string; FOrientation: TJvYearGridOrientation; FSavedScrollBars: TScrollStyle; {$IFNDEF USECUSTOMGRID} procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint); {$ENDIF !USECUSTOMGRID} procedure DoShowHint(var HintStr: THintString; var CanShow: Boolean; var HintInfo: THintInfo); procedure MakeHTML(AList: TStringList; Border, Filter: Boolean); procedure SetHTMLBorder(const Value: Boolean); procedure SetYearChanged(const Value: TOnYearChanged); procedure SetYear(const Value: Integer); procedure SetupYearData; procedure SetupMonths; function GetCellData(var S: string): Boolean; function SetCellData(S: string): Boolean; procedure Copy1Click(Sender: TObject); procedure Cut1Click(Sender: TObject); procedure Delete1Click(Sender: TObject); procedure Paste1Click(Sender: TObject); procedure CreatePopup; procedure Edit1Click(Sender: TObject); procedure Year1Click(Sender: TObject); procedure Color1Click(Sender: TObject); procedure NoColor1Click(Sender: TObject); procedure SetupGridPop(Sender: TObject); procedure SaveAsHTML(Sender: TObject); procedure Launch(AFile: string); procedure SetHTMLFontName(const Value: string); procedure SetSelectDate(const Value: TOnSelectDate); procedure SetBorderColor(const Value: TColor); procedure BorderColor1Click(Sender: TObject); procedure SetInfoChanging(const Value: TOnInfoChanging); function DateToCell(ADate: TDate; var ACol, ARow: Integer): Boolean; procedure ClearBookMarks; procedure SetBookMarkColor(const Value: TColor); procedure BookMarkColor1Click(Sender: TObject); procedure Find1Click(Sender: TObject); procedure ClearFind1Click(Sender: TObject); procedure SaveFound(Sender: TObject); procedure SetOrientation(const Value: TJvYearGridOrientation); function IsCurrentYear: Boolean; private FFirstDayOfWeek: TJvWeekDay; FWeekendDays: TJvWeekDaySet; FAutoSizeOptions: TJvAutoSizeOptions; {$IFDEF USEJVCL} FCellMargins: TJvRect; {$ENDIF USEJVCL} {$IFNDEF USECUSTOMGRID} FOnSelectCell: TSelectCellEvent; FOnDrawCell: TDrawCellEvent; {$ENDIF !USECUSTOMGRID} FDaysAlignment: TAlignment; FDayNamesAlignment: TAlignment; FMonthNamesAlignment: TAlignment; FYearAlignment: TAlignment; FYear: Integer; {$IFDEF USEJVCL} procedure CellMarginsChange(Sender: TObject); {$ENDIF USEJVCL} procedure SetFirstDayOfWeek(const Value: TJvWeekDay); function GetDefaultColWidth: Integer; function GetDefaultRowHeight: Integer; procedure SetDefaultColWidth(const Value: Integer); procedure SetDefaultRowHeihgt(const Value: Integer); procedure SetFirstColWidth(const Value: Integer); procedure SetFirstRowHeight(const Value: Integer); procedure SetWeekendDays(const Value: TJvWeekDaySet); procedure SetAutoSizeOptions(const Value: TJvAutoSizeOptions); {$IFDEF USEJVCL} procedure SetCellMargins(const Value: TJvRect); {$ENDIF USEJVCL} procedure SetDayNamesAlignment(const Value: TAlignment); procedure SetDaysAlignment(const Value: TAlignment); procedure SetMonthNamesAlignment(const Value: TAlignment); procedure SetYearAlignment(const Value: TAlignment); function GetFirstColWidth: Integer; function GetFirstRowHeight: Integer; procedure ColRowToDayMonthIndex(ACol, ARow: Integer; var DayIndex, MonthIndex: Integer); procedure DayMonthIndexToColRow(DayIndex: Integer; MonthIndex: Integer; var ACol, ARow: Integer); protected procedure DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); override; function SelectCell(ACol, ARow: Integer): Boolean; override; procedure DblClick; override; procedure SetAutoSize(Value: Boolean); {$IFDEF USECUSTOMGRID} override; {$ENDIF} procedure UpdateAllSizes; procedure AdjustBounds; procedure Loaded; override; procedure SetParent({$IFDEF VisualCLX} const {$ENDIF} AParent: TWinControl); override; // Those three methods are used to provide support for reading // the GridYear property from DFM files that were using // this component before its rewrite. The writer does nothing // because the value is now stored as Year. procedure ReadGridYear(Reader: TReader); procedure WriteGridYear(Writer: TWriter); procedure DefineProperties(Filer: TFiler); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure LoadYear(FileName: string = ''); procedure SaveYear(FileName: string = ''); function GetSelDateText: string; procedure SetSelDateText(AText: string); function GetDateInfo(ADate: TDate; var AText: string): Boolean; function SetDateInfo(ADate: TDate; AText: string): Boolean; // This procedure does the default drawing for a given cell // It is made public so that you can call it in your OnDrawCell event procedure DefaultDrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); // Converts a (col, row) couple to a (day, month) couple taking // into account the orientation. If no day is in the indicated cell // then the value of ADay is 0 on exit. procedure ColRowToDayMonth(ACol, ARow: Integer; var ADay, AMonth: Integer); // Converts a (day, month) couple to a (col, row) couple taking // into account the orientation. If the day doesn't exist in the month // the indicated cell may be outside the grid procedure DayMonthToColRow(ADay, AMonth: Integer; var ACol, ARow: Integer); procedure Find; published property HTMLBorder: Boolean read FHTMLBorder write SetHTMLBorder; property HTMLFontName: string read FHTMLFontName write SetHTMLFontName; property BorderColor: TColor read FBorderColor write SetBorderColor default JvDefaultBorderColor; property BookMarkColor: TColor read FBookMarkColor write SetBookMarkColor default clYellow; property Orientation: TJvYearGridOrientation read FOrientation write SetOrientation default yoHorizontal; property FirstDayOfWeek: TJvWeekDay read FFirstDayOfWeek write SetFirstDayOfWeek default wdMonday; property Year: Integer read FYear write SetYear; property YearFile: string read FYearFile write FYearFile; property AutoSize: Boolean read FAutoSize write SetAutoSize default True; property AutoSizeOptions: TJvAutoSizeOptions read FAutoSizeOptions write SetAutoSizeOptions; property FirstColWidth: Integer read GetFirstColWidth write SetFirstColWidth; property FirstRowHeight: Integer read GetFirstRowHeight write SetFirstRowHeight; {$IFDEF USEJVCL} property CellMargins: TJvRect read FCellMargins write SetCellMargins; {$ENDIF USEJVCL} property WeekendDays: TJvWeekDaySet read FWeekendDays write SetWeekendDays; property MonthNamesAlignment: TAlignment read FMonthNamesAlignment write SetMonthNamesAlignment default taLeftJustify; property DayNamesAlignment: TAlignment read FDayNamesAlignment write SetDayNamesAlignment default taLeftJustify; property DaysAlignment: TAlignment read FDaysAlignment write SetDaysAlignment default taLeftJustify; property YearAlignment: TAlignment read FYearAlignment write SetYearAlignment default taLeftJustify; {$IFDEF USECUSTOMGRID} property OnSelectCell; property OnDrawCell; {$ELSE} property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell; property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell; {$ENDIF USECUSTOMGRID} property OnYearChanged: TOnYearChanged read FOnYearChanged write SetYearChanged; property OnSelectDate: TOnSelectDate read FOnSelectDate write SetSelectDate; property OnInfoChanging: TOnInfoChanging read FOnInfoChanging write SetInfoChanging; property OnDblClick; property OnClick; property DefaultColWidth: Integer read GetDefaultColWidth write SetDefaultColWidth default 16; property DefaultRowHeight: Integer read GetDefaultRowHeight write SetDefaultRowHeihgt default 18; property ScrollBars; end; {.$HPPEMIT '#undef TDate'} {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} const UnitVersioning: TUnitVersionInfo = ( RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvYearGrid.pas $'; Revision: '$Revision: 10613 $'; Date: '$Date: 2006-05-19 21:21:43 +0200 (ven., 19 mai 2006) $'; LogPath: 'JVCL\run' ); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} implementation uses {$IFDEF USEJVCL} JvConsts, JvResources, {$ENDIF USEJVCL} JvYearGridEditForm; {$IFNDEF USEJVCL} resourcestring RsYearGrid = 'YearGrid'; RsEnterYear = 'Enter year (1999-2050):'; RsInvalidYear = 'invalid year'; RsYear = '&Year...'; RsEdit = '&Edit'; RsColor = '&Color...'; RsNoColor = '&No Color'; RsSaveAllInfo = '&Save All Info'; RsSaveFoundInfo = 'Save Found Info'; RsBorderColor = '&Border Color...'; RsBookMarkColor = 'Book&Mark Color...'; RsFindItem = '&Find...'; RsClearFind = 'Clear Find'; RsYearGridFind = 'YearGrid Find'; RsEnterSeachText = 'Enter seach text:'; RsFounds = 'Found %s'; RsToday = 'Today '; RsCutItem = 'Cu&t'; RsCopyItem = '&Copy'; RsPasteItem = '&Paste'; RsDeleteItem = '&Delete'; {$ENDIF !USEJVCL} {$IFNDEF USEJVCL} const Cr = #13; {$ENDIF !USEJVCL} const TodayFontColor = clWhite; TodayBrushColor = clRed; constructor TJvYearGrid.Create(AOwner: TComponent); var AYear, AMonth, ADay: Word; begin inherited Create(AOwner); {$IFDEF USEJVCL} FCellMargins := TJvRect.Create; FCellMargins.Top := 1; FCellMargins.Left := 1; FCellMargins.Bottom := 1; FCellMargins.Right := 1; FCellMargins.OnChange := CellMarginsChange; // Must be set last {$ENDIF USEJVCL} FOrientation := yoHorizontal; FFirstDayOfWeek := wdMonday; FWeekendDays := [wdSaturday, wdSunday]; FAutoSizeOptions := [aoGrid, aoFirstColumn, aoFirstRow, aoColumns, aoRows]; FBorderColor := JvDefaultBorderColor; FBookMarkColor := clYellow; ShowHint := True; CreatePopup; PopupMenu := FGridPop; FGridPop.OnPopup := SetupGridPop; // Those two must be set before setting DefaultColWidth and DefaultRowHeight FirstRowHeight := 18; FirstColWidth := 70; DefaultColWidth := 16; DefaultRowHeight := 18;//FFirstRowHeight; ColCount := 38; RowCount := 13; Width := 512; Height := 213; // THIS IS WRONG, VERY WRONG! (obones) Application.ShowHint := True; Application.OnShowHint := DoShowHint; Application.HintHidePause := 5000; DecodeDate(Now, FCurrentYear, FCurrentMonth, FCurrentDay); HTMLFontName := 'Arial'; DecodeDate(Now, AYear, AMonth, ADay); FYear := AYear; SetupYearData; FAutoSize := True; FSavedScrollBars := ScrollBars; Invalidate; end; destructor TJvYearGrid.Destroy; begin // SaveYear; FGridPop.Free; {$IFDEF USEJVCL} FCellMargins.Free; {$ENDIF USEJVCL} inherited Destroy; end; procedure TJvYearGrid.DrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); begin if Assigned(OnDrawCell) then OnDrawCell(Self, ACol, ARow, Rect, State) else begin DefaultDrawCell(ACol, ARow, Rect, State); end; end; procedure TJvYearGrid.DoShowHint(var HintStr: THintString; var CanShow: Boolean; var HintInfo: THintInfo); var ACol, ARow, X, Y: Integer; S, DS: string; begin if HintInfo.HintControl = Self then begin X := HintInfo.CursorPos.X; Y := HintInfo.CursorPos.Y; MouseToCell(X, Y, ACol, ARow); if (ACol < 0) or (ARow < 0) then Exit; DS := FYearData[ACol, ARow].DisplayText; if IsCurrentYear and (ARow = FCurrentMonth) and (DS = IntToStr(FCurrentDay)) then S := RsToday; CanShow := False; if (ACol >= 0) and (ARow >= 0) then begin S := S + FYearData[ACol, ARow].InfoText; if S <> '' then begin HintInfo.CursorRect := CellRect(ACol, ARow); HintStr := S; CanShow := True; end; end; end; end; procedure TJvYearGrid.MakeHTML(AList: TStringList; Border, Filter: Boolean); var ACol, ARow, W: Integer; DS, Tbs, Infs: string; Month, Day: Word; ADate: TDate; CanAdd: Boolean; begin AList.Clear; if Border then Tbs := '1' else Tbs := '0'; AList.Append('Year ' + IntToStr(Year) + ''); AList.Append(''); AList.Append(''); AList.Append('

Year ' + IntToStr(Year) + '

'); AList.Append(''); for ARow := 1 to 12 do for ACol := 1 to 37 do begin CanAdd := FYearData[ACol, ARow].DisplayText <> ''; if CanAdd then CanAdd := FYearData[ACol, ARow].InfoText <> ''; if CanAdd and Filter then CanAdd := FYearData[ACol, ARow].BookMark; if CanAdd then begin Month := ARow; Day := StrToInt(FYearData[ACol, ARow].DisplayText); ADate := EncodeDate(Year, Month, Day); DS := FormatDateTime('d-mmm-yyyy', ADate); W := DayOfWeek(ADate); DS := ShortDayNames[W] + ' ' + DS; AList.Append(''); AList.Append(''); Infs := FYearData[ACol, ARow].InfoText; Infs := StringReplace(Infs, Cr, '
', [rfReplaceAll]); AList.Append(''); AList.Append(''); end; end; AList.Append('
' + DS + '' + Infs + '
'); AList.Append('
'); end; procedure TJvYearGrid.SaveAsHTML(Sender: TObject); var List: TStringList; FileName: string; begin List := TStringList.Create; MakeHTML(List, HTMLBorder, False); FileName := ChangeFileExt(FYearFile, '.htm'); List.SaveToFile(FileName); List.Free; Launch(FileName); end; procedure TJvYearGrid.SetHTMLBorder(const Value: Boolean); begin FHTMLBorder := Value; end; procedure TJvYearGrid.SetYearChanged(const Value: TOnYearChanged); begin FOnYearChanged := Value; end; procedure TJvYearGrid.SetYear(const Value: Integer); var AYear, AMonth, ADay: Word; begin if Value <> FYear then begin FYear := Value; if Value = 0 then begin DecodeDate(Now, AYear, AMonth, ADay); FYear := AYear; end else FYear := Value; SetupYearData; if Assigned(FOnYearChanged) then FOnYearChanged(Self, FYear); end; end; procedure TJvYearGrid.SaveYear(FileName: string); var MonthIndex, DayIndex: Integer; YList, DList: TStringList; S: string; begin YList := TStringList.Create; DList := TStringList.Create; for MonthIndex := 0 to 12 do begin for DayIndex := 0 to 37 do begin DList.Clear; DList.Append(FYearData[DayIndex, MonthIndex].DisplayText); S := FYearData[DayIndex, MonthIndex].InfoText; S := StringReplace(S, Cr, '||', [rfReplaceAll]); DList.Append(S); DList.Append(ColorToString(FYearData[DayIndex, MonthIndex].DefaultColor)); DList.Append(ColorToString(FYearData[DayIndex, MonthIndex].CustomColor)); if FYearData[DayIndex, MonthIndex].Custom then S := 'true' else S := 'false'; DList.Append(S); YList.Append(DList.CommaText); end; end; if FileName = '' then YList.SaveToFile(FYearFile) else YList.SaveToFile(FileName); DList.Free; YList.Free; end; procedure TJvYearGrid.LoadYear(FileName: string); 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 {$IFDEF VCL} if Clipboard.HasFormat(CF_TEXT) then {$ENDIF VCL} {$IFDEF VisualCLX} if Clipboard.AsText <> '' then {$ENDIF VisualCLX} 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); {$IFDEF VCL} CD.Options := [cdFullOpen, cdAnyColor]; {$ENDIF VCL} 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 := ''; {$IFDEF VCL} ShellExecute(GetForegroundWindow, 'open', PChar(Command), PChar(Params), PChar(WorkDir), SW_SHOWNORMAL); {$ENDIF VCL} {$IFDEF VisualCLX} ShellExecute(HWND_DESKTOP, 'open', PChar(Command), PChar(Params), PChar(WorkDir), SW_SHOWNORMAL); {$ENDIF VisualCLX} 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); {$IFDEF VCL} CD.Options := [cdFullOpen, cdAnyColor]; {$ENDIF VCL} if CD.Execute then BorderColor := CD.Color; CD.Free; end; procedure TJvYearGrid.BookMarkColor1Click(Sender: TObject); var CD: TColorDialog; begin CD := TColorDialog.Create(Application); {$IFDEF VCL} CD.Options := [cdFullOpen, cdAnyColor]; {$ENDIF VCL} 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; var AYear, AMonth, ADay: Word; WD: Integer; begin Result := False; DecodeDate(ADate, AYear, AMonth, ADay); if AYear <> Self.Year then Exit; WD := DayOfWeek(EncodeDate(AYear, AMonth, 1)); Inc(WD, Integer(FirstDayOfWeek)); if WD > 7 then Dec(WD, 7); DayMonthIndexToColRow(WD + ADay - 1, AMonth, ACol, ARow); Result := True; end; function TJvYearGrid.GetDateInfo(ADate: TDate; var AText: string): Boolean; var Col, Row: Integer; begin Result := DateToCell(ADate, Col, Row); if Result then AText := FYearData[Col, Row].InfoText; end; function TJvYearGrid.SetDateInfo(ADate: TDate; AText: string): Boolean; var Col, Row: Integer; begin Result := DateToCell(ADate, Col, Row); if Result then FYearData[Col, Row].InfoText := AText; end; procedure TJvYearGrid.SetBookMarkColor(const Value: TColor); begin if Value <> FBookMarkColor then begin FBookMarkColor := Value; Invalidate; end; end; procedure TJvYearGrid.Find1Click(Sender: TObject); var S: string; Col, Row: Integer; begin ClearBookMarks; S := InputBox(RsYearGridFind, RsEnterSeachText, ''); if S = '' then Exit; S := LowerCase(S); for Row := 0 to 12 do for Col := 0 to 37 do if Pos(S, LowerCase(FYearData[Col, Row].InfoText)) > 0 then FYearData[Col, Row].BookMark := True; Invalidate; end; procedure TJvYearGrid.ClearFind1Click(Sender: TObject); begin ClearBookMarks; end; procedure TJvYearGrid.Find; begin Find1Click(nil); end; procedure TJvYearGrid.SaveFound(Sender: TObject); var List: TStringList; FileName: string; begin List := TStringList.Create; MakeHTML(List, HTMLBorder, True); FileName := Format(RsFounds, [ChangeFileExt(FYearFile, '.htm')]); List.SaveToFile(FileName); List.Free; Launch(FileName); end; procedure TJvYearGrid.SetOrientation(const Value: TJvYearGridOrientation); begin if FOrientation <> Value then begin FOrientation := Value; if FOrientation = yoHorizontal then begin ColCount := 38; RowCount := 13; end else begin ColCount := 13; RowCount := 38; end; AdjustBounds; Invalidate; end; end; procedure TJvYearGrid.SetFirstDayOfWeek(const Value: TJvWeekDay); begin if FFirstDayOfWeek <> Value then begin FFirstDayOfWeek := Value; SetupYearData; end; end; procedure TJvYearGrid.SetAutoSize(Value: Boolean); begin if Value then begin if (aoGrid in AutoSizeOptions) then begin FSavedScrollBars := ScrollBars; ScrollBars := ssNone; end; end else ScrollBars := FSavedScrollBars; FAutoSize := Value; AdjustBounds; end; function TJvYearGrid.GetDefaultColWidth: Integer; begin Result := inherited DefaultColWidth; end; function TJvYearGrid.GetDefaultRowHeight: Integer; begin Result := inherited DefaultRowHeight; end; procedure TJvYearGrid.SetDefaultColWidth(const Value: Integer); var SavedFirstColWidth: Integer; begin SavedFirstColWidth := ColWidths[0]; inherited DefaultColWidth := Value; ColWidths[0] := SavedFirstColWidth; end; procedure TJvYearGrid.SetDefaultRowHeihgt(const Value: Integer); var SavedFirstRowHeight: Integer; begin SavedFirstRowHeight := RowHeights[0]; inherited DefaultRowHeight := Value; RowHeights[0] := SavedFirstRowHeight; end; procedure TJvYearGrid.SetFirstColWidth(const Value: Integer); begin ColWidths[0] := Value; end; procedure TJvYearGrid.SetFirstRowHeight(const Value: Integer); begin RowHeights[0] := Value; end; procedure TJvYearGrid.SetWeekendDays(const Value: TJvWeekDaySet); begin FWeekendDays := Value; end; procedure TJvYearGrid.SetAutoSizeOptions(const Value: TJvAutoSizeOptions); begin FAutoSizeOptions := Value; end; procedure TJvYearGrid.UpdateAllSizes; var I: Integer; CurValue: Integer; MaxValue: Integer; function GetHighestTextInRow(Row: Integer): Integer; var I: Integer; CurValue: Integer; begin // find the highest text in the row. Result := 0; for I := 0 to ColCount-1 do begin if Orientation = yoHorizontal then CurValue := Canvas.TextHeight(FYearData[I,Row].DisplayText) else CurValue := Canvas.TextHeight(FYearData[Row,I].DisplayText); if CurValue > Result then Result := CurValue; end; end; function GetLargestTextInColumn(Column: Integer): Integer; var I: Integer; CurValue: Integer; begin // find the largest text in the column Result := 0; for I := 0 to RowCount-1 do begin if Orientation = yoHorizontal then CurValue := Canvas.TextWidth(FYearData[Column,I].DisplayText) else CurValue := Canvas.TextWidth(FYearData[I,Column].DisplayText); if CurValue > Result then Result := CurValue; end; end; begin if AutoSize then begin if aoFirstRow in AutoSizeOptions then RowHeights[0] := GetHighestTextInRow(0) {$IFDEF USEJVCL} + CellMargins.Top + CellMargins.Bottom {$ENDIF}; if aoFirstColumn in AutoSizeOptions then ColWidths[0] := GetLargestTextInColumn(0) {$IFDEF USEJVCL} + CellMargins.Left + CellMargins.Right {$ENDIF}; if aoRows in AutoSizeOptions then begin // find the highest text in each row and only use the // highest value among those found MaxValue := 0; for I := 1 to RowCount-1 do begin CurValue := GetHighestTextInRow(I); if CurValue > MaxValue then MaxValue := CurValue; end; for I := 1 to RowCount-1 do RowHeights[I] := MaxValue {$IFDEF USEJVCL} + CellMargins.Top + CellMargins.Bottom {$ENDIF}; end; if aoColumns in AutoSizeOptions then begin // find the largest text in each column and only use // the highest value among those found MaxValue := 0; for I := 1 to ColCount-1 do begin CurValue := GetLargestTextInColumn(I); if CurValue > MaxValue then MaxValue := CurValue; end; for I := 1 to ColCount-1 do ColWidths[I] := MaxValue {$IFDEF USEJVCL} + CellMargins.Left + CellMargins.Top {$ENDIF}; end; end; end; {$IFDEF USEJVCL} procedure TJvYearGrid.SetCellMargins(const Value: TJvRect); begin FCellMargins.Assign(Value); AdjustBounds; end; {$ENDIF USEJVCL} procedure TJvYearGrid.AdjustBounds; var I: Integer; NewWidth, NewHeight: Integer; begin if not (csReading in ComponentState) and FAutoSize then begin UpdateAllSizes; if aoGrid in AutoSizeOptions then begin NewWidth := GridLineWidth + {GetSystemMetrics(SM_CXVSCROLL) +} 4; for I := 0 to ColCount-1 do Inc(NewWidth, ColWidths[I]+GridLineWidth); NewHeight := GridLineWidth + {GetSystemMetrics(SM_CYHSCROLL) +} 4; for I := 0 to RowCount-1 do Inc(NewHeight, RowHeights[I]+GridLineWidth); SetBounds(Left, Top, NewWidth, NewHeight); end; end; end; procedure TJvYearGrid.Loaded; begin inherited Loaded; AdjustBounds; end; procedure TJvYearGrid.SetParent({$IFDEF VisualCLX} const {$ENDIF} AParent: TWinControl); begin inherited SetParent(AParent); if Parent <> nil then AdjustBounds; end; {$IFDEF USEJVCL} procedure TJvYearGrid.CellMarginsChange(Sender: TObject); begin AdjustBounds; end; {$ENDIF USEJVCL} procedure TJvYearGrid.SetDayNamesAlignment(const Value: TAlignment); begin if FDayNamesAlignment <> Value then begin FDayNamesAlignment := Value; Invalidate; end; end; procedure TJvYearGrid.SetDaysAlignment(const Value: TAlignment); begin if FDaysAlignment <> Value then begin FDaysAlignment := Value; Invalidate; end; end; procedure TJvYearGrid.SetMonthNamesAlignment(const Value: TAlignment); begin if FMonthNamesAlignment <> Value then begin FMonthNamesAlignment := Value; Invalidate; end; end; procedure TJvYearGrid.SetYearAlignment(const Value: TAlignment); begin if FYearAlignment <> Value then begin FYearAlignment := Value; Invalidate; end; end; function TJvYearGrid.GetFirstColWidth: Integer; begin Result := ColWidths[0]; end; function TJvYearGrid.GetFirstRowHeight: Integer; begin Result := RowHeights[0]; end; function TJvYearGrid.IsCurrentYear: Boolean; begin Result := Year = FCurrentYear; end; {$IFNDEF USECUSTOMGRID} procedure TJvYearGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Integer); var Coord: TGridCoord; begin Coord := MouseCoord(X, Y); ACol := Coord.X; ARow := Coord.Y; end; {$ENDIF !USECUSTOMGRID} procedure TJvYearGrid.ReadGridYear(Reader: TReader); begin Year := Reader.ReadInteger; end; procedure TJvYearGrid.WriteGridYear(Writer: TWriter); begin // Do nothing, we only provide read support for legacy reasons end; procedure TJvYearGrid.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('GridYear', ReadGridYear, WriteGridYear, False); end; procedure TJvYearGrid.ColRowToDayMonthIndex(ACol, ARow: Integer; var DayIndex, MonthIndex: Integer); begin if Orientation = yoHorizontal then begin DayIndex := ACol; MonthIndex := ARow; end else begin DayIndex := ARow; MonthIndex := ACol; end; end; procedure TJvYearGrid.DayMonthIndexToColRow(DayIndex, MonthIndex: Integer; var ACol, ARow: Integer); begin if Orientation = yoHorizontal then begin ACol := DayIndex; ARow := MonthIndex; end else begin ARow := DayIndex; ACol := MonthIndex; end; end; procedure TJvYearGrid.ColRowToDayMonth(ACol, ARow: Integer; var ADay, AMonth: Integer); var DayIndex, MonthIndex: Integer; begin ColRowToDayMonthIndex(ACol, ARow, DayIndex, MonthIndex); AMonth := MonthIndex; ADay := FYearData[MonthIndex, DayIndex].DayInMonth; end; procedure TJvYearGrid.DayMonthToColRow(ADay, AMonth: Integer; var ACol, ARow: Integer); begin DayMonthIndexToColRow(ADay, AMonth, ACol, ARow); end; procedure TJvYearGrid.DefaultDrawCell(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var S: string; MonthIndex: Integer; DayIndex: Integer; SWidth: Integer; TextLeft: Integer; function GetTextLeft(Alignment: TAlignment): Integer; begin case Alignment of taRightJustify: Result := Rect.Right - SWidth {$IFDEF USEJVCL} - CellMargins.Right {$ENDIF}; taCenter: Result := Rect.Left + (Rect.Right-Rect.Left - SWidth {$IFDEF USEJVCL} - CellMargins.Left - CellMargins.Right {$ENDIF} + 2) div 2; else Result := Rect.Left {$IFDEF USEJVCL} + CellMargins.Left {$ENDIF}; end; end; begin ColRowToDayMonthIndex(ACol, ARow, DayIndex, MonthIndex); S := FYearData[DayIndex, MonthIndex].DisplayText; TextLeft := Rect.Left; with Canvas do begin SWidth := TextWidth(S); Font.Color := clBlack; Font.Style := Font.Style - [fsBold]; if (DayIndex = 0) then begin Brush.Color := BorderColor; TextLeft := GetTextLeft(MonthNamesAlignment); end; if (MonthIndex = 0) then begin if (FYearData[DayIndex, MonthIndex].DefaultColor = clWhite) then Brush.Color := BorderColor; if DayIndex = 0 then TextLeft := GetTextLeft(YearAlignment) else TextLeft := GetTextLeft(DayNamesAlignment); end; if (DayIndex > 0) and (MonthIndex > 0) then begin TextLeft := GetTextLeft(DaysAlignment); if IsCurrentYear and (MonthIndex = FCurrentMonth) and (S = IntToStr(FCurrentDay)) then begin Font.Color := TodayFontColor; Brush.Color := TodayBrushColor; Font.Style := Font.Style + [fsBold]; end else if FYearData[DayIndex, MonthIndex].Custom then Brush.Color := FYearData[DayIndex, MonthIndex].CustomColor else Brush.Color := FYearData[DayIndex, MonthIndex].DefaultColor; end; if FYearData[DayIndex, MonthIndex].BookMark then Brush.Color := BookMarkColor; TextRect(Rect, TextLeft, Rect.Top, S); end; end; {$IFDEF USEJVCL} {$IFDEF UNITVERSIONING} initialization RegisterUnitVersion(HInstance, UnitVersioning); finalization UnregisterUnitVersion(HInstance); {$ENDIF UNITVERSIONING} {$ENDIF USEJVCL} end.