git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@7 05c56307-c608-d34a-929d-697000501d7a
325 lines
10 KiB
ObjectPascal
325 lines
10 KiB
ObjectPascal
unit Office11GroupRowStyleDemoMain;
|
|
|
|
{$I ..\..\cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Forms, Messages, SysUtils, Classes, ActnList, ImgList, Controls, Menus,
|
|
StdCtrls, cxButtons, cxCheckBox, cxContainer, cxEdit, cxTextEdit,
|
|
cxMaskEdit, cxSpinEdit, ExtCtrls, cxGridLevel, cxGridCustomTableView,
|
|
cxGridCardView, cxGridDBCardView, cxClasses, cxControls,
|
|
cxGridCustomView, cxGrid, ComCtrls, cxStyles, cxCustomData, cxGraphics,
|
|
cxFilter, cxData, DB, cxDBData, cxDataStorage, cxLookAndFeelPainters,
|
|
cxLookAndFeels, cxHyperLinkEdit, cxImageComboBox, cxDBLookupComboBox,
|
|
cxMemo, cxGridTableView;
|
|
|
|
type
|
|
TOffice11GroupRowStyleDemoMainForm = class(TForm)
|
|
mmMain: TMainMenu;
|
|
miAbout: TMenuItem;
|
|
miFile: TMenuItem;
|
|
miOptions: TMenuItem;
|
|
miExit: TMenuItem;
|
|
sbMain: TStatusBar;
|
|
lbDescrip: TLabel;
|
|
LookAndFeelController: TcxLookAndFeelController;
|
|
imgImportance: TImageList;
|
|
Grid: TcxGrid;
|
|
tvMail: TcxGridTableView;
|
|
tvMailImportance: TcxGridColumn;
|
|
tvMailIcon: TcxGridColumn;
|
|
tvMailAttachment: TcxGridColumn;
|
|
tvMailFrom: TcxGridColumn;
|
|
tvMailSubject: TcxGridColumn;
|
|
tvMailReceived: TcxGridColumn;
|
|
tvMailSent: TcxGridColumn;
|
|
lvMail: TcxGridLevel;
|
|
miOffice11GroupRowStyle: TMenuItem;
|
|
miAlwaysExpandedGroups: TMenuItem;
|
|
miGroupBySorting: TMenuItem;
|
|
procedure miAboutClick(Sender: TObject);
|
|
procedure miExitClick(Sender: TObject);
|
|
procedure tvMailDataControllerCompare(
|
|
ADataController: TcxCustomDataController; ARecordIndex1,
|
|
ARecordIndex2, AItemIndex: Integer; const V1, V2: Variant;
|
|
var Compare: Integer);
|
|
procedure tvMailSentGetDisplayText(Sender: TcxCustomGridTableItem;
|
|
ARecord: TcxCustomGridRecord; var AText: String);
|
|
procedure tvMailStylesGetContentStyle(
|
|
Sender: TcxCustomGridTableView; ARecord: TcxCustomGridRecord;
|
|
AItem: TcxCustomGridTableItem; out AStyle: TcxStyle);
|
|
procedure miOffice11GroupRowStyleClick(Sender: TObject);
|
|
procedure miAlwaysExpandedGroupsClick(Sender: TObject);
|
|
procedure miGroupBySortingClick(Sender: TObject);
|
|
private
|
|
procedure AddRecordIntoTable(ARecordIndex: Integer);
|
|
procedure AddRecordsIntoTable;
|
|
function GetDateValueIndex(ADate: TDateTime): Integer;
|
|
function GetGroupDateDisplayText(ADate: TDateTime): string;
|
|
function tblPersons: TDataSet;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
var
|
|
Office11GroupRowStyleDemoMainForm: TOffice11GroupRowStyleDemoMainForm;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
{$IFDEF DELPHI6}
|
|
DateUtils,
|
|
{$ENDIF}
|
|
Office11GroupRowStyleDemoData, Dialogs, AboutDemoForm,
|
|
cxVariants;
|
|
|
|
const
|
|
DateValueIndexToday = 0;
|
|
DateValueIndexYesterday = 1;
|
|
DateValueIndexLastWeek = 2;
|
|
DateValueIndexTwoWeeksAgo = 3;
|
|
DateValueIndexOlder = 4;
|
|
|
|
{$IFNDEF DELPHI6}
|
|
// DateUtils
|
|
|
|
const
|
|
HoursPerDay = 24;
|
|
MinsPerDay = HoursPerDay * 60;
|
|
|
|
function IncDay(const AValue: TDateTime;
|
|
const ANumberOfDays: Integer = 1): TDateTime;
|
|
begin
|
|
Result := AValue + ANumberOfDays;
|
|
end;
|
|
|
|
function IncHour(const AValue: TDateTime;
|
|
const ANumberOfHours: Int64): TDateTime;
|
|
begin
|
|
Result := (AValue * HoursPerDay + ANumberOfHours) / HoursPerDay;
|
|
end;
|
|
|
|
function IncMinute(const AValue: TDateTime;
|
|
const ANumberOfMinutes: Int64): TDateTime;
|
|
begin
|
|
Result := (AValue * MinsPerDay + ANumberOfMinutes) / MinsPerDay;
|
|
end;
|
|
|
|
function DaysBetween(const ANow, AThen: TDateTime): Integer;
|
|
begin
|
|
if ANow > AThen then
|
|
Result := Trunc(ANow - AThen)
|
|
else
|
|
Result := Trunc(AThen - ANow);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.miAboutClick(Sender: TObject);
|
|
begin
|
|
ShowAboutDemoForm;
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.miExitClick(Sender: TObject);
|
|
begin
|
|
Close;
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.AddRecordIntoTable(ARecordIndex: Integer);
|
|
|
|
function GetImportance: Integer;
|
|
begin
|
|
Result := Random(10);
|
|
if(Result > 2) then
|
|
Result := 1;
|
|
end;
|
|
|
|
function GetIcon: Integer;
|
|
begin
|
|
Result := Random(4);
|
|
if Result > 1 then
|
|
Result := 1;
|
|
end;
|
|
|
|
function GetSent: TDateTime;
|
|
begin
|
|
Result := Now;
|
|
if(Random(6) = 1) then exit;
|
|
Result := IncDay(Result, -Random(50));
|
|
Result := IncHour(Result, -Random(4));
|
|
Result := IncMinute(Result, -Random(60));
|
|
end;
|
|
|
|
function GetReceived(ASent: TDateTime): TDateTime;
|
|
begin
|
|
Result := IncMinute(ASent, 10 + Random(120));
|
|
end;
|
|
|
|
function GetSubject: string;
|
|
const
|
|
Count = 21;
|
|
Subjects : array[0..Count - 1] of string = (
|
|
'Implementing the Developer Express MasterView control into an Accounting System.',
|
|
'Web Edition: Data Entry Page. The date validation issue.',
|
|
'Payables Due Calculator. It is ready for testing.',
|
|
'Web Edition: Search Page. It is ready for testing.',
|
|
'Main Menu: Duplicate Items. Somebody has to review all the menu items in the system.',
|
|
'Receivables Calculator. Where can I find the complete specs',
|
|
'Ledger: Inconsistency. Please fix it.',
|
|
'Receivables Printing. It is ready for testing.',
|
|
'Screen Redraw. Somebody has to look at it.',
|
|
'Email System. What library are we going to use?',
|
|
'Adding New Vendors Fails. This module doesn''t work properly!',
|
|
'History. Will we track the sales history in our system?',
|
|
'Main Menu: Add a File menu. File menu is missing!!!',
|
|
'Currency Mask. The current currency mask is extremely inconvenient.',
|
|
'Drag & Drop. In the schedule module drag & drop is not available.',
|
|
'Data Import. What competitors databases will we support?',
|
|
'Reports. The list of incomplete reports.',
|
|
'Data Archiving. This features is still missing in our application',
|
|
'Email Attachments. How to add multiple attachments? I can''t see how to do it.',
|
|
'Check Register. We are using different paths for different modules.',
|
|
'Data Export. Our customers asked for export into Excel');
|
|
|
|
begin
|
|
Result := Subjects[Random(Count)];
|
|
end;
|
|
|
|
var
|
|
ASent: TDateTime;
|
|
begin
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailImportance.Index, GetImportance);
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailIcon.Index, GetIcon);
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailAttachment.Index, GetIcon);
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailFrom.Index,
|
|
Office11GroupRowStyleDemoDataDM.tblPersonsFullName.Text);
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailSubject.Index, GetSubject);
|
|
ASent := GetSent;
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailReceived.Index, GetReceived(ASent));
|
|
tvMail.DataController.SetValue(ARecordIndex, tvMailSent.Index, ASent);
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.AddRecordsIntoTable;
|
|
const
|
|
RecordCount = 5;
|
|
var
|
|
J: Integer;
|
|
begin
|
|
Randomize;
|
|
tvMail.BeginUpdate;
|
|
tblPersons.DisableControls;
|
|
try
|
|
tvMail.DataController.RecordCount := tblPersons.RecordCount * RecordCount;
|
|
tblPersons.First;
|
|
while not tblPersons.Eof do
|
|
begin
|
|
for J := 0 to RecordCount - 1 do
|
|
AddRecordIntoTable((tblPersons.RecNo - 1) * RecordCount + J);
|
|
tblPersons.Next;
|
|
end;
|
|
finally
|
|
tblPersons.EnableControls;
|
|
tvMail.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
constructor TOffice11GroupRowStyleDemoMainForm.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
AddRecordsIntoTable;
|
|
end;
|
|
|
|
function TOffice11GroupRowStyleDemoMainForm.GetDateValueIndex(ADate: TDateTime): Integer;
|
|
var
|
|
ADaysBetween: Integer;
|
|
begin
|
|
ADaysBetween := DaysBetween(Date, Trunc(ADate));
|
|
Result := DateValueIndexOlder;
|
|
if ADaysBetween = 0 then
|
|
Result := DateValueIndexToday
|
|
else
|
|
if ADaysBetween = 1 then
|
|
Result := DateValueIndexYesterday
|
|
else
|
|
if ADaysBetween < 7 then
|
|
Result := DateValueIndexLastWeek
|
|
else
|
|
if ADaysBetween < 14 then
|
|
Result := DateValueIndexTwoWeeksAgo;
|
|
end;
|
|
|
|
function TOffice11GroupRowStyleDemoMainForm.GetGroupDateDisplayText(ADate: TDateTime): string;
|
|
const
|
|
DisplayText: Array[DateValueIndexToday..DateValueIndexOlder] of String =
|
|
('Today', 'Yesterday', 'Last Week', 'Two Weeks Ago', 'Older');
|
|
begin
|
|
Result := DisplayText[GetDateValueIndex(ADate)];
|
|
end;
|
|
|
|
function TOffice11GroupRowStyleDemoMainForm.tblPersons: TDataSet;
|
|
begin
|
|
Result := Office11GroupRowStyleDemoDataDM.tblPersons;
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.tvMailDataControllerCompare(
|
|
ADataController: TcxCustomDataController; ARecordIndex1, ARecordIndex2,
|
|
AItemIndex: Integer; const V1, V2: Variant; var Compare: Integer);
|
|
begin
|
|
if ((AItemIndex = tvMailSent.Index) and (tvMailSent.GroupIndex <> -1)) or
|
|
((AItemIndex = tvMailReceived.Index) and (tvMailReceived.GroupIndex <> -1)) then
|
|
Compare := GetDateValueIndex(V1) - GetDateValueIndex(V2)
|
|
else
|
|
Compare := VarCompare(V1, V2);
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.tvMailSentGetDisplayText(
|
|
Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord;
|
|
var AText: String);
|
|
begin
|
|
if ARecord is TcxGridGroupRow then
|
|
AText := GetGroupDateDisplayText(ARecord.Values[Sender.Index]);
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.tvMailStylesGetContentStyle(
|
|
Sender: TcxCustomGridTableView; ARecord: TcxCustomGridRecord;
|
|
AItem: TcxCustomGridTableItem; out AStyle: TcxStyle);
|
|
begin
|
|
if ARecord is TcxGridDataRow then
|
|
begin
|
|
if ARecord.Values[tvMailIcon.Index] = 0 then
|
|
AStyle := Office11GroupRowStyleDemoDataDM.UnreadStyle;
|
|
end;
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.miOffice11GroupRowStyleClick(
|
|
Sender: TObject);
|
|
begin
|
|
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
|
|
tvMail.OptionsView.GroupRowStyle :=
|
|
TcxGridGroupRowStyle(TMenuItem(Sender).Checked);
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.miAlwaysExpandedGroupsClick(
|
|
Sender: TObject);
|
|
begin
|
|
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
|
|
if TMenuItem(Sender).Checked then
|
|
tvMail.DataController.Options :=
|
|
tvMail.DataController.Options + [dcoGroupsAlwaysExpanded]
|
|
else
|
|
tvMail.DataController.Options :=
|
|
tvMail.DataController.Options - [dcoGroupsAlwaysExpanded];
|
|
end;
|
|
|
|
procedure TOffice11GroupRowStyleDemoMainForm.miGroupBySortingClick(
|
|
Sender: TObject);
|
|
begin
|
|
TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
|
|
tvMail.OptionsCustomize.GroupBySorting := TMenuItem(Sender).Checked;
|
|
end;
|
|
|
|
end.
|