cxpropertiesstoreeditor.pas
来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,002 行 · 第 1/2 页
PAS
1,002 行
ChangeCheckState(Tree.Selected);
finally
EndUpdate();
end;
end;
end;
procedure TfrmPropertiesStoreEditor.btnCheckAllClick(Sender: TObject);
begin
CheckAll;
end;
procedure TfrmPropertiesStoreEditor.btnUncheckAllClick(Sender: TObject);
begin
UncheckAll;
end;
procedure TfrmPropertiesStoreEditor.LoadFromPropertiesStore(
APropertiesStore: TcxPropertiesStore);
function ExtractName(var AName: string): string;
var
AIndex: Integer;
begin
Result := '';
AIndex := Pos('.', AName);
if AIndex > 0 then
begin
if AIndex > 1 then
Result := Copy(AName, 1, AIndex - 1);
Delete(AName, 1, AIndex);
end
else
begin
Result := AName;
AName := '';
end;
end;
function GetPropertyNode(APersistentNode: TTreeNode; const APropertyName: string): TTreeNode;
var
AName: string;
AUpperCaseCurrentName: string;
ACurrentName: string;
I: Integer;
begin
Result := nil;
AName := APropertyName;
ACurrentName := ExtractName(AName);
if ACurrentName <> '' then
begin
AUpperCaseCurrentName := UpperCase(ACurrentName);
for I := 0 to APersistentNode.Count - 1 do
if UpperCase(APersistentNode[I].Text) = AUpperCaseCurrentName then
begin
Result := APersistentNode[I];
Break;
end;
if Result <> nil then
begin
if AName <> '' then
Result := GetPropertyNode(Result, AName);
end;
end;
end;
function GetPersistentNode(APersistent: TPersistent): TTreeNode;
var
ANode: TTreeNode;
begin
Result := nil;
ANode := Tree.Items.GetFirstNode;
while ANode <> nil do
begin
if ANode.Data <> nil then
with PfrmPropertiesStoreRecord(ANode.Data)^ do
if (Persistent = APersistent) and (PropertyName = '') then
begin
Result := ANode;
Break;
end;
ANode := ANode.getNextSibling;
end;
end;
function GetPersistentNodeByProperty(var APropertyName: string; APersistent: TPersistent): TTreeNode;
var
APropertyNode: TTreeNode;
AName: string;
AUpperCaseName: string;
I: Integer;
begin
Result := nil;
if (APropertyName = '') or (APersistent = nil) then
Exit;
AName := ExtractName(APropertyName);
if AName <> '' then
begin
AUpperCaseName := UpperCase(AName);
APropertyNode := Tree.Items.GetFirstNode;
while APropertyNode <> nil do
begin
if AUpperCaseName = UpperCase(APropertyNode.Text) then
for I := 0 to APropertyNode.Count - 1 do
if APropertyNode[I].Data <> nil then
if PfrmPropertiesStoreRecord(APropertyNode[I].Data)^.Persistent = APersistent then
begin
Result := APropertyNode[I];
Exit;
end;
APropertyNode := APropertyNode.getNextSibling;
end;
end;
end;
var
APS: TcxPropertiesStore;
I, J: Integer;
APersistentNode: TTreeNode;
APropertyNode: TTreeNode;
APropertyName: string;
begin
if APropertiesStore = nil then
APS := PropertiesStore
else
APS := APropertiesStore;
if APS <> nil then
begin
for I := 0 to APS.Components.Count - 1 do
with APS.Components[I] do
begin
if Grouping = psgComponents then
begin
APersistentNode := GetPersistentNode(Component);
if APersistentNode <> nil then
begin
for J := 0 to Properties.Count - 1 do
begin
APropertyNode := GetPropertyNode(APersistentNode, Properties[J]);
if APropertyNode <> nil then
if APropertyNode.Data <> nil then
CheckNode(APropertyNode);
end;
end;
end
else if Grouping = psgProperties then
begin
for J := 0 to Properties.Count - 1 do
begin
APropertyName := Properties[J];
APersistentNode := GetPersistentNodeByProperty(APropertyName, Component);
if APersistentNode <> nil then
begin
if APropertyName <> '' then
begin
APropertyNode := GetPropertyNode(APersistentNode, APropertyName);
if APropertyNode <> nil then
CheckNode(APropertyNode);
end
else
CheckNode(APersistentNode);
end;
end;
end;
end;
end;
end;
procedure TfrmPropertiesStoreEditor.FormShow(Sender: TObject);
begin
LoadFromPropertiesStore(nil);
end;
procedure TfrmPropertiesStoreEditor.btnResetClick(Sender: TObject);
begin
Reset;
end;
procedure TfrmPropertiesStoreEditor.SaveToPropertiesStore(
APropertiesStore: TcxPropertiesStore);
var
APS: TcxPropertiesStore;
procedure SaveComponentProperties(APSC: TcxPropertiesStoreComponent;
ANode: TTreeNode; const AName: string);
var
I: Integer;
begin
for I := 0 to ANode.Count - 1 do
begin
if IsNodeFullChecked(ANode[I]) then
APSC.Properties.Add(AName + '.' + ANode[I].Text)
else
begin
if IsNodeChecked(ANode[I]) then
SaveComponentProperties(APSC, ANode[I], AName + '.' + ANode[I].Text);
end;
end;
end;
procedure SaveComponent(APersistentNode: TTreeNode);
var
APSC: TcxPropertiesStoreComponent;
APersistent: TPersistent;
I: Integer;
begin
APersistent := PfrmPropertiesStoreRecord(APersistentNode.Data)^.Persistent;
if APersistent is TComponent then
begin
APSC := APS.Components.Add as TcxPropertiesStoreComponent;
APSC.Component := APersistent as TComponent;
for I := 0 to APersistentNode.Count - 1 do
begin
if IsNodeFullChecked(APersistentNode[I]) then
APSC.Properties.Add(APersistentNode[I].Text)
else
begin
if IsNodeChecked(APersistentNode[I]) then
SaveComponentProperties(APSC, APersistentNode[I], APersistentNode[I].Text);
end;
end;
end;
end;
function GetPropertiesStoreComponent(AComponent: TComponent): TcxPropertiesStoreComponent;
var
I: Integer;
begin
Result := nil;
for I := 0 to APS.Components.Count - 1 do
if APS.Components[I].Component = AComponent then
begin
Result := APS.Components[I];
Break;
end;
if Result = nil then
begin
Result := APS.Components.Add as TcxPropertiesStoreComponent;
Result.Component := AComponent;
end;
end;
procedure SaveComponentByProperty(APropertyNode: TTreeNode);
var
APropertyName: string;
I: Integer;
APSC: TcxPropertiesStoreComponent;
APersistent: TPersistent;
begin
APropertyName := APropertyNode.Text;
for I := 0 to APropertyNode.Count - 1 do
begin
if IsNodeChecked(APropertyNode[I]) then
begin
APersistent := PfrmPropertiesStoreRecord(APropertyNode[I].Data)^.Persistent;
if APersistent is TComponent then
begin
APSC := GetPropertiesStoreComponent(APersistent as TComponent);
if IsNodeFullChecked(APropertyNode[I]) then
APSC.Properties.Add(APropertyName)
else
SaveComponentProperties(APSC, APropertyNode[I], APropertyName);
end;
end;
end;
end;
var
ANode: TTreeNode;
begin
if APropertiesStore = nil then
APS := PropertiesStore
else
APS := APropertiesStore;
if APS <> nil then
begin
APS.Components.Clear;
ANode := Tree.Items.GetFirstNode;
while ANode <> nil do
begin
if IsNodeChecked(ANode) then
begin
if ANode.Data <> nil then
begin
if Grouping = psgComponents then
SaveComponent(ANode)
else if Grouping = psgProperties then
SaveComponentByProperty(ANode);
end;
end;
ANode := ANode.getNextSibling;
end;
end;
end;
function TfrmPropertiesStoreEditor.IsNodeFullChecked(
ANode: TTreeNode): Boolean;
var
I: Integer;
begin
Result := PfrmPropertiesStoreRecord(ANode.Data)^.Stored;
if Result then
begin
for I := 0 to ANode.Count - 1 do
Result := Result and IsNodeFullChecked(ANode[I]);
end;
end;
function TfrmPropertiesStoreEditor.IsNodeChecked(
ANode: TTreeNode): Boolean;
begin
Result := PfrmPropertiesStoreRecord(ANode.Data)^.Stored;
end;
procedure TfrmPropertiesStoreEditor.BeginUpdate;
begin
Tree.Items.BeginUpdate;
end;
procedure TfrmPropertiesStoreEditor.EndUpdate;
begin
Tree.Items.EndUpdate;
end;
procedure TfrmPropertiesStoreEditor.InvertCheck;
procedure InvertCheckNode(ANode: TTreeNode);
var
I: Integer;
begin
for I := 0 to ANode.Count - 1 do
begin
if IsNodeChecked(ANode[I]) then
begin
if IsNodeFullChecked(ANode[I]) then
UncheckNode(ANode[I])
else
InvertCheckNode(ANode[I]);
end
else
CheckNode(ANode[I]);
end;
end;
var
ANode: TTreeNode;
begin
ANode := Tree.Items.GetFirstNode;
while ANode <> nil do
begin
if IsNodeChecked(ANode) then
begin
if IsNodeFullChecked(ANode) then
UncheckNode(ANode)
else
InvertCheckNode(ANode);
end
else
CheckNode(ANode);
ANode := ANode.getNextSibling;
end;
end;
procedure TfrmPropertiesStoreEditor.btnInvertCheckingClick(Sender: TObject);
begin
InvertChecking;
end;
procedure TfrmPropertiesStoreEditor.SetFindText;
begin
if Grouping = psgComponents then
lblFindComponent.Caption := scxFindComponent
else if Grouping = psgProperties then
lblFindComponent.Caption := scxFindProperty;
edFindComponent.Left := lblFindComponent.Left + lblFindComponent.Width + 9;
edFindComponent.Width := Tree.Left + Tree.Width - edFindComponent.Left - 7;
end;
procedure TfrmPropertiesStoreEditor.edFindComponentKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
var
ANode: TTreeNode;
begin
if TranslateKey(Key) = VK_RETURN then
begin
ANode := FindNode(edFindComponent.Text);
if ANode <> nil then
begin
Tree.Selected := ANode;
Tree.SetFocus;
end;
end;
end;
function TfrmPropertiesStoreEditor.FindNode(const AText: string): TTreeNode;
var
I: Integer;
ANode: TTreeNode;
ANodeText: string;
AFindText: string;
ACount, ACount1: Integer;
begin
AFindText := UpperCase(AText);
ANode := Tree.Items.GetFirstNode;
ACount1 := -1;
Result := nil;
while ANode <> nil do
begin
ACount := 0;
ANodeText := UpperCase(ANode.Text);
for I := 1 to Length(AFindText) do
begin
if I > Length(ANodeText) then
Break;
if AFindText[I] = ANodeText[I] then
Inc(ACount)
else
Break;
end;
if ACount > ACount1 then
begin
ACount1 := ACount;
Result := ANode;
end;
ANode := ANode.getNextSibling;
end;
end;
procedure TfrmPropertiesStoreEditor.CheckAll;
var
ANode: TTreeNode;
begin
BeginUpdate;
try
ANode := Tree.Items.GetFirstNode;
while ANode <> nil do
begin
CheckNode(ANode, True, False);
ANode := ANode.getNextSibling;
end;
finally
EndUpdate;
end;
end;
procedure TfrmPropertiesStoreEditor.InvertChecking;
begin
BeginUpdate;
try
InvertCheck;
finally
EndUpdate;
end;
end;
procedure TfrmPropertiesStoreEditor.Reset;
begin
BeginUpdate;
try
RefreshTree;
LoadFromPropertiesStore(nil);
finally
EndUpdate;
end;
end;
procedure TfrmPropertiesStoreEditor.UncheckAll;
var
ANode: TTreeNode;
begin
BeginUpdate;
try
ANode := Tree.Items.GetFirstNode;
while ANode <> nil do
begin
if PfrmPropertiesStoreRecord(ANode.Data)^.Stored then
UncheckNode(ANode, True, False);
ANode := ANode.getNextSibling;
end;
finally
EndUpdate;
end;
end;
procedure TfrmPropertiesStoreEditor.TreeContextPopup(Sender: TObject;
MousePos: TPoint; var Handled: Boolean);
begin
if Tree.Selected <> nil then
begin
BeginUpdate;
try
ChangeCheckState(Tree.Selected);
finally
EndUpdate;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?