david
8a45a23220
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@7 05c56307-c608-d34a-929d-697000501d7a
334 lines
8.7 KiB
ObjectPascal
334 lines
8.7 KiB
ObjectPascal
unit UnboundModeDemoMain;
|
|
|
|
{$I ..\cxVer.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, {$IFDEF DELPHI6}Variants, {$ENDIF}Classes, Graphics, Controls, Forms,
|
|
Dialogs, cxControls, cxLookAndFeels, ActnList, ImgList, Menus, ComCtrls,
|
|
StdCtrls, DemoBasicMain, cxContainer, cxEdit, cxTextEdit, cxStyles, cxTL,
|
|
cxInplaceContainer, cxEditRepositoryItems, cxGraphics, cxCustomData,
|
|
cxSpinEdit, ToolWin, DB, DBClient, cxTLData, cxDBTL;
|
|
|
|
type
|
|
TUnboundModeDemoMainForm = class(TDemoBasicMainForm)
|
|
miGridLookFeel: TMenuItem;
|
|
miKind: TMenuItem;
|
|
miFlat: TMenuItem;
|
|
miStandard: TMenuItem;
|
|
miUltraFlat: TMenuItem;
|
|
miNativeStyle: TMenuItem;
|
|
miSeparator2: TMenuItem;
|
|
tlPlanets: TcxTreeList;
|
|
clName: TcxTreeListColumn;
|
|
clOrbitNumb: TcxTreeListColumn;
|
|
clOrbits: TcxTreeListColumn;
|
|
clDistance: TcxTreeListColumn;
|
|
clPeriod: TcxTreeListColumn;
|
|
clDiscoverer: TcxTreeListColumn;
|
|
clDate: TcxTreeListColumn;
|
|
clRadius: TcxTreeListColumn;
|
|
clImageIndex: TcxTreeListColumn;
|
|
ilPlanets: TImageList;
|
|
edrepMain: TcxEditRepository;
|
|
edrepCenterText: TcxEditRepositoryTextItem;
|
|
edrepRightText: TcxEditRepositoryTextItem;
|
|
Office111: TMenuItem;
|
|
clPosicion: TcxTreeListColumn;
|
|
ToolBar1: TToolBar;
|
|
ToolButton1: TToolButton;
|
|
ToolButton2: TToolButton;
|
|
ToolButton3: TToolButton;
|
|
actSubir: TAction;
|
|
actBajar: TAction;
|
|
clPosCalculada: TcxTreeListColumn;
|
|
actExpandir: TAction;
|
|
procedure LookAndFeelChange(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure tlPlanetsDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
procedure actSubirExecute(Sender: TObject);
|
|
procedure actBajarExecute(Sender: TObject);
|
|
procedure actBajarUpdate(Sender: TObject);
|
|
procedure clPosCalculadaGetDisplayText(Sender: TcxTreeListColumn;
|
|
ANode: TcxTreeListNode; var Value: string);
|
|
procedure actSubirUpdate(Sender: TObject);
|
|
procedure actExpandirExecute(Sender: TObject);
|
|
private
|
|
procedure CustomizeColumns;
|
|
procedure LoadData;
|
|
function IsUp(Up: Boolean): Integer;
|
|
function CanMoveRecord(Up: Boolean = True): Boolean;
|
|
procedure MoveRecord(Up: Boolean = True);
|
|
procedure SetRecordOrder(OrderValue: Integer);
|
|
end;
|
|
|
|
var
|
|
UnboundModeDemoMainForm: TUnboundModeDemoMainForm;
|
|
|
|
implementation
|
|
|
|
|
|
uses UnboundModeDemoData, ShellAPI, cxDataStorage;
|
|
|
|
const
|
|
cDistance = 3;
|
|
cPeriod = 4;
|
|
cRadius = 7;
|
|
cImageIndex = 8;
|
|
cPosicion = 9;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TUnboundModeDemoMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
{ remove/add the closing brace on this line to disable/enable the following code}
|
|
|
|
CustomizeColumns;
|
|
LoadData;
|
|
tlPlanets.FullCollapse;
|
|
tlPlanets.Nodes.Root[0].Expanded := True;
|
|
|
|
//}
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.FormShow(Sender: TObject);
|
|
begin
|
|
{ remove/add the closing brace on this line to disable/enable the following code
|
|
|
|
ShowMessage('WARNING: tutorial not completed. First, please apply the steps '+
|
|
'shown in the doc file');
|
|
|
|
//}
|
|
end;
|
|
|
|
|
|
procedure TUnboundModeDemoMainForm.tlPlanetsDragOver(Sender,
|
|
Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
|
|
begin
|
|
inherited;
|
|
//
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.clPosCalculadaGetDisplayText(
|
|
Sender: TcxTreeListColumn; ANode: TcxTreeListNode; var Value: string);
|
|
begin
|
|
inherited;
|
|
Value := IntToStr(ANode.AbsoluteIndex);
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.CustomizeColumns;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
with tlPlanets do
|
|
for I := 0 to ColumnCount - 1 do
|
|
if I in [cDistance, cRadius, cImageIndex, cPosicion] then
|
|
Columns[I].DataBinding.ValueTypeClass := TcxIntegerValueType
|
|
else
|
|
if I in [cPeriod] then
|
|
Columns[I].DataBinding.ValueTypeClass := TcxFloatValueType
|
|
else
|
|
Columns[I].DataBinding.ValueTypeClass := TcxStringValueType;
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.LoadData;
|
|
const
|
|
AFileName = 'nineplanets.txt';
|
|
AHeaderLineCount = 2;
|
|
AParentKeyField = 2;
|
|
AKeyField = 0;
|
|
AImageField = 8;
|
|
|
|
var
|
|
ARecords, AValues: TStringList;
|
|
I: Integer;
|
|
|
|
function AddNode(AParentNode: TcxTreeListNode;
|
|
const ARecord: string): TcxTreeListNode;
|
|
var
|
|
S1: string;
|
|
J: Integer;
|
|
V: Variant;
|
|
begin
|
|
Result := AParentNode.AddChild;
|
|
AValues.CommaText := ARecord;
|
|
for J := 0 to AValues.Count - 1 do
|
|
if AValues.Strings[J] <> '-' then
|
|
begin
|
|
S1 := AValues.Strings[J];
|
|
if Pos('.', S1) <> 0 then
|
|
S1[Pos('.', S1)] := DecimalSeparator;
|
|
V := S1;
|
|
if not VarIsNull(V) then
|
|
Result.Values[J] := V;
|
|
end;
|
|
Result.ImageIndex := Result.Values[AImageField];
|
|
Result.SelectedIndex := Result.Values[AImageField];
|
|
end;
|
|
|
|
procedure AddNodes(AParentNode: TcxTreeListNode;
|
|
const AParentKeyValue: string);
|
|
|
|
function GetFieldValue(ARecord: string; AFieldIndex: Integer): string;
|
|
begin
|
|
AValues.CommaText := ARecord;
|
|
Result := AValues.Strings[AFieldIndex];
|
|
end;
|
|
var
|
|
J: Integer;
|
|
ANode: TcxTreeListNode;
|
|
begin
|
|
for J := 0 to ARecords.Count - 1 do
|
|
if GetFieldValue(ARecords.Strings[J], AParentKeyField) = AParentKeyValue then
|
|
begin
|
|
ANode := AddNode(AParentNode, ARecords.Strings[J]);
|
|
AddNodes(ANode, GetFieldValue(ARecords.Strings[J], AKeyField));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if not FileExists(AFileName) then
|
|
raise Exception.Create('Data file not found');
|
|
|
|
ARecords := TStringList.Create;
|
|
AValues := TStringList.Create;
|
|
|
|
tlPlanets.BeginUpdate;
|
|
with ARecords do
|
|
try
|
|
LoadFromFile(AFileName);
|
|
for I := 0 to AHeaderLineCount - 1 do
|
|
Delete(0);
|
|
AddNodes(tlPlanets.Nodes.Root, '-');
|
|
finally
|
|
tlPlanets.EndUpdate;
|
|
ARecords.Free;
|
|
AValues.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.LookAndFeelChange(Sender: TObject);
|
|
begin
|
|
if TMenuItem(Sender).Tag > 3 then
|
|
begin
|
|
cxLookAndFeelController.NativeStyle :=
|
|
not cxLookAndFeelController.NativeStyle;
|
|
TMenuItem(Sender).Checked := cxLookAndFeelController.NativeStyle;
|
|
end
|
|
else
|
|
begin
|
|
TMenuItem(Sender).Checked := True;
|
|
cxLookAndFeelController.Kind := TcxLookAndFeelKind(TMenuItem(Sender).Tag);
|
|
cxLookAndFeelController.NativeStyle := False;
|
|
miNativeStyle.Checked := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure TUnboundModeDemoMainForm.actBajarExecute(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
MoveRecord(False);
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.actBajarUpdate(Sender: TObject);
|
|
begin
|
|
(Sender as TAction).Enabled := CanMoveRecord(False);
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.actExpandirExecute(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
tlPlanets.FocusedNode.Expand(True);
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.actSubirExecute(Sender: TObject);
|
|
var
|
|
ANodoAnterior : TcxTreeListNode;
|
|
begin
|
|
inherited;
|
|
{ with tlPlanets.FocusedNode do
|
|
begin
|
|
ANodoAnterior := GetPrev;
|
|
if Assigned(ANodoAnterior) then
|
|
begin
|
|
MoveTo(GetPrev, tlamInsert);
|
|
ANodoAnterior.Expand(True);
|
|
end;
|
|
end;}
|
|
MoveRecord(True);
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.actSubirUpdate(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
(Sender as TAction).Enabled := CanMoveRecord(True);
|
|
end;
|
|
|
|
function TUnboundModeDemoMainForm.CanMoveRecord(Up: Boolean): Boolean;
|
|
var
|
|
ANode : TcxTreeListNode;
|
|
begin
|
|
if Up then
|
|
Result := not tlPlanets.FocusedNode.IsFirstVisible
|
|
else begin
|
|
ANode := tlPlanets.FocusedNode.getNext;
|
|
Result := Assigned(ANode);
|
|
end;
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.MoveRecord(Up: Boolean);
|
|
var
|
|
AKeyValue, AOldKeyValue, AOrderValue: Integer;
|
|
AParentNode: TcxTreeListNode;
|
|
ANode: TcxTreeListNode;
|
|
begin
|
|
if not CanMoveRecord(Up) then
|
|
Exit;
|
|
|
|
with tlPlanets do
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
if Up then
|
|
ANode := FocusedNode.GetPrev
|
|
else
|
|
ANode := FocusedNode.GetNext;
|
|
|
|
if Assigned(ANode) then
|
|
begin
|
|
if Up then
|
|
FocusedNode.MoveTo(ANode, tlamInsert)
|
|
else
|
|
FocusedNode.MoveTo(ANode, tlamInsert);
|
|
FocusedNode.MakeVisible;
|
|
FocusedNode.Focused := True;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TUnboundModeDemoMainForm.SetRecordOrder(OrderValue: Integer);
|
|
begin
|
|
with tlPlanets.FocusedNode do
|
|
Values[cPosicion] := AbsoluteIndex;
|
|
end;
|
|
|
|
function TUnboundModeDemoMainForm.IsUp(Up: Boolean): Integer;
|
|
begin
|
|
if Up then
|
|
Result := 1
|
|
else
|
|
Result := -1;
|
|
end;
|
|
|
|
|
|
|
|
end.
|