📄 jvqyeargrid.pas
字号:
{******************************************************************************}
{* WARNING: JEDI VCL To CLX Converter generated unit. *}
{* Manual modifications will be lost on next release. *}
{******************************************************************************}
{-----------------------------------------------------------------------------
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: JvQYearGrid.pas,v 1.20 2005/02/06 14:06:32 asnepvangers Exp $
unit JvQYearGrid;
{$I jvcl.inc}
interface
uses
{$IFDEF MSWINDOWS}
ShellAPI,
{$ENDIF MSWINDOWS}
QWindows, QMessages, QGraphics, QControls, QForms, QDialogs, QGrids, QMenus, QClipbrd,
JvQJVCLUtils, JvQTypes,
SysUtils, QStdCtrls, Classes;
const
JvDefaultBorderColor = TColor($EEF5FF);
type
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;
FCellMargins: TJvRect;
{$IFNDEF USECUSTOMGRID}
FOnSelectCell: TSelectCellEvent;
FOnDrawCell: TDrawCellEvent;
{$ENDIF !USECUSTOMGRID}
FDaysAlignment: TAlignment;
FDayNamesAlignment: TAlignment;
FMonthNamesAlignment: TAlignment;
FYearAlignment: TAlignment;
FYear: Integer;
procedure CellMarginsChange(Sender: TObject);
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);
procedure SetCellMargins(const Value: TJvRect);
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( const 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;
property CellMargins: TJvRect read FCellMargins write SetCellMargins;
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'}
implementation
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
JvQConsts, JvQResources,
JvQYearGridEditForm;
const
TodayFontColor = clWhite;
TodayBrushColor = clRed;
constructor TJvYearGrid.Create(AOwner: TComponent);
var
AYear, AMonth, ADay: Word;
begin
inherited Create(AOwner);
FCellMargins := TJvRect.Create;
FCellMargins.Top := 1;
FCellMargins.Left := 1;
FCellMargins.Bottom := 1;
FCellMargins.Right := 1;
FCellMargins.OnChange := CellMarginsChange; // Must be set last
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;
FCellMargins.Free;
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('<html><head><title>Year ' + IntToStr(Year) + '</title></head>');
AList.Append('<body>');
AList.Append('<font size=2 face="' + HTMLFontName + '">');
AList.Append('<center><h3>Year ' + IntToStr(Year) + '</h3></center>');
AList.Append('<Table width=100% border=' + Tbs + '>');
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('<tr>');
AList.Append('<td width=20%>' + DS + '</td>');
Infs := FYearData[ACol, ARow].InfoText;
Infs := StringReplace(Infs, Cr, '<br>', [rfReplaceAll]);
AList.Append('<td>' + Infs + '</td>');
AList.Append('</tr>');
end;
end;
AList.Append('</table>');
AList.Append('</font></body></html>');
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);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -