cxoicollectioned.pas

delphi的的三方控件

  UpdateListbox;
{$ENDIF}
  LockState;
  try
    for I := FItemIDList.Count - 1 downto 0 do
    begin
      Item := Collection.FindItemID(Integer(FItemIDList[I]));
      if Item <> nil then
        ListView1.Items[Item.Index].Selected := True
      else FItemIDList.Delete(I);
    end;
  finally
    UnlockState;
  end;
end;

procedure TcxCollectionEditor.LockState;
begin
  Inc(FStateLock);
end;

procedure TcxCollectionEditor.SetCollectionPropertyName(const Value: string);
begin
  if Value <> FCollectionPropertyName then
  begin
    FCollectionPropertyName := Value;
    Caption := Format(cxGetResourceString(@cxSvgRTTICollectionEditCaption),
      [Component.Name, DotSep, Value]);
  end;
end;

procedure TcxCollectionEditor.SetSelection;
var
  I: Integer;
{$IFDEF RTTIMULTISELECTION}
  List: TList;
{$ENDIF}
begin
  UpdateListBox;
  if FSelectionError then Exit;
  try
    if ListView1.SelCount > 0 then
    begin
    {$IFDEF RTTIMULTISELECTION}
      List := TList.Create;
      try
    {$ENDIF}
        FItemIDList.Clear;
        for I := 0 to ListView1.Items.Count - 1 do
          if ListView1.Items[I].Selected then
          begin
          {$IFDEF RTTIMULTISELECTION}
            List.Add(Collection.Items[I]);
          {$ENDIF}
            Inspector.InspectedObject := Collection.Items[I];
            FItemIDList.Add(Pointer(Collection.Items[I].ID));
          end;
    {$IFDEF RTTIMULTISELECTION}
        Inspector.SetSelections(List);
      finally
        List.Free;
      end;
    {$ENDIF}
    end
    else
      Inspector.InspectedObject := Collection;
    Inspector.RefreshInspectedProperties;
  except
    FSelectionError := True;
    Application.HandleException(ExceptObject);
    Close;
  end;
end;

procedure TcxCollectionEditor.UnlockState;
begin
  Dec(FStateLock);
end;

procedure TcxCollectionEditor.UpdateListbox;
var
  I, J: Integer;

  procedure UpdateSizes;
  var
    I: Integer;
  begin
    with TRegIniFile.Create(GetRegKey) do
    try
      Top := ReadInteger(FCollectionClassName, 'Top', 100);
      Left := ReadInteger(FCollectionClassName, 'Left', 100);
      Width := ReadInteger(FCollectionClassName, 'Width', Width);
      Height := ReadInteger(FCollectionClassName, 'Height', Height);
      ToolBar1.Visible := ReadBool(FCollectionClassName, 'Toolbar', True);
      acTextLabels.Checked := ReadBool(FCollectionClassName, 'TextLabels', False);
      ListView1.HandleNeeded;
      if ListView1.Columns.Count > 1 then
        for I := 0 to ListView1.Columns.Count - 1 do
          ListView1.Column[I].Width := ReadInteger(FCollectionClassName,
            Format('Column%d', [I]), ListView1.Column[I].WidthType);
    finally
      Free;
    end;
  end;

  procedure UpdateColumns;
  var
    I: Integer;
  begin
    if (Collection <> nil) and
      (((TCollectionAccess(Collection).GetAttrCount > 0) and
      (ListView1.Columns.Count <> TCollectionAccess(Collection).GetAttrCount)) or
      ((ListView1.Columns.Count = 0) and
      (TCollectionAccess(Collection).GetAttrCount < 1))) then
    begin
      ListView1.HandleNeeded;
      with TCollectionAccess(Collection) do
      begin
        if GetAttrCount >= 1 then
          for I := 0 to GetAttrCount - 1 do
            with ListView1.Columns.Add do
            begin
              Caption := GetAttr(I);
              Width := -2;
            end
        else
          with ListView1.Columns.Add do
            Width := -1;
        if GetAttrCount >= 1 then
          ListView1.ShowColumnHeaders := True
      end;
      UpdateSizes;
    end;
  end;

  procedure FetchItems(List: TStrings);
  var
    I, J: Integer;
    SubList: TStringList;
  begin
    if Collection <> nil then
      for I := 0 to Collection.Count - 1 do
        if CanAdd(I) then
        begin
          SubList := TStringList.Create;
          for J := 1 to TCollectionAccess(Collection).GetAttrCount - 1 do
            SubList.Add(GetItemName(J, I));
          List.AddObject(GetItemName(0, I), SubList);
        end;

  end;

  function ItemsEqual(ListItems: TListItems; Items: TStrings): Boolean;
  var
    I, J: Integer;
  begin
    Result := False;
    if ListItems.Count <> Items.Count then Exit;
    for I := 0 to ListItems.Count - 1 do
    begin
      if ListItems[I].Caption = Items[I] then
      begin
        for J := 0 to ListItems[I].SubItems.Count - 1 do
          if ListItems[I].SubItems[J] <> TStrings(Items.Objects[I])[J] then
            Exit;
      end
      else
        Exit;
    end;
    Result := True;
  end;

var
  TmpItems: TStringList;
begin
  if Collection = nil then Exit;
  LockState;
  try
    TmpItems := TStringList.Create;
    FetchItems(TmpItems);
    try
      if (TmpItems.Count = 0) or not ItemsEqual(ListView1.Items, TmpItems) then
      begin
        ListView1.Items.BeginUpdate;
        try
          UpdateColumns;
          ListView1.Items.Clear;
          for I := 0 to TmpItems.Count - 1 do
            with ListView1.Items.Add do
            begin
              Caption := TmpItems[I];
              for J := 0 to TStrings(TmpItems.Objects[I]).Count - 1 do
                SubItems.Add(TStrings(TmpItems.Objects[I])[J]);
            end;
        finally
          ListView1.Items.EndUpdate;
        end;
      end;
    finally
      for I := 0 to TmpItems.Count - 1 do
        TStrings(TmpItems.Objects[I]).Free;
      TmpItems.Free;
    end;
  finally
    UnlockState;
  end;
end;

procedure TcxCollectionEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  I: Integer;
begin
  if Component <> nil then
    Inspector.InspectedObject := Component;
  with TRegIniFile.Create(GetRegKey) do
  try
    EraseSection(FCollectionClassName);
    WriteInteger(FCollectionClassName, 'Left', Left);
    WriteInteger(FCollectionClassName, 'Top', Top);
    WriteInteger(FCollectionClassName, 'Width', Width);
    WriteInteger(FCollectionClassName, 'Height', Height);
    WriteBool(FCollectionClassName, 'TextLabels', acTextLabels.Checked);
    WriteBool(FCollectionClassName, 'Toolbar', ToolBar1.Visible);
    for I := 0 to ListView1.Columns.Count - 1 do
      WriteInteger(FCollectionClassName, Format('Column%d', [I]),
        ListView1.Column[I].WidthType);
  finally
    Free;
  end;
  Action := caFree;
  LockState;
end;

procedure TcxCollectionEditor.FormCreate(Sender: TObject);
begin
  Localize;
  FItemIdList := TList.Create;
  cxCollectionEditorsList.Add(Self);
end;

procedure TcxCollectionEditor.FormDestroy(Sender: TObject);
begin
  Inspector.RemoveListener(Self);
  FItemIdList.Free;
  if cxCollectionEditorsList <> nil then
    cxCollectionEditorsList.Remove(Self);
end;

procedure TcxCollectionEditor.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_PROCESSKEY then
    with Inspector do
      if CanFocusEx then
      begin
        SetFocus;
        ShowEdit;
      end;
end;

procedure TcxCollectionEditor.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    with Inspector do
      if CanFocusEx then
      begin
        SetFocus;
        ShowEdit;
      end;
end;

procedure TcxCollectionEditor.FormShow(Sender: TObject);
{$IFNDEF DELPHI6}
var
  ALeft: Integer;
  ATop: Integer;
{$ENDIF}
begin
{$IFNDEF DELPHI6}
  ALeft := Left;
  ATop := Top;
  if Left + Width > Monitor.Left + Monitor.Width then
    ALeft := Monitor.Left + Monitor.Width - Width;
  if Left < Monitor.Left then
    ALeft := Monitor.Left;
  if Top + Height > Monitor.Top + Monitor.Height then
    ATop := Monitor.Top + Monitor.Height - Height;
  if Top < Monitor.Top then
    ATop := Monitor.Top;
  SetBounds(ALeft, ATop, Width, Height);
{$ELSE}
  MakeFullyVisible;
{$ENDIF}
end;

procedure TcxCollectionEditor.ListView1Change(Sender: TObject;
  Item: TListItem; Change: TItemChange);
var
  Msg: TMsg;
begin
  if (Change = ctState) and (FStateLock = 0) then
    if not PeekMessage(Msg, Handle, AM_DeferUpdate, AM_DeferUpdate, PM_NOREMOVE) then
      PostMessage(Handle, AM_DeferUpdate, 0, 0);
end;

procedure TcxCollectionEditor.ListView1DragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Item: TListItem;
  I, J, InsPos: Integer;
  L: TList;
begin
  Item := ListView1.GetItemAt(X, Y);
  if Item <> nil then
    InsPos := Item.Index
  else Exit;
  L := TList.Create;
  try
    for I := 0 to ListView1.Items.Count - 1 do
      if ListView1.Items[I].Selected then
        L.Add(Collection.Items[I]);

    Collection.BeginUpdate;
    try
      for I := 0 to L.Count - 1 do
      with TCollectionItem(L[I]) do
      begin
        J := Index;
        Index := InsPos;
        if (J > InsPos) and (InsPos < Collection.Count) then
          Inc(InsPos);
      end;
    finally
      Collection.EndUpdate;
    end;
  finally
    L.Free;
  end;
  GetSelection;
end;

procedure TcxCollectionEditor.ListView1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Item: TListItem;
begin
  Item := ListView1.GetItemAt(X, Y);
  Accept := (Item <> nil) and (Source = ListView1) and
    (not Item.Selected);
end;

procedure TcxCollectionEditor.ListView1KeyDown(Sender: TObject; var Key: word;
  Shift: TShiftState);
begin
  if Key = VK_PROCESSKEY then
    Inspector.SetFocus;
end;

procedure TcxCollectionEditor.ListView1KeyPress(Sender: TObject;
  var Key: Char);
begin
  if (Key in ['!'..'~']) and Inspector.CanFocusEx then
  begin
    Inspector.SetFocus;
    Inspector.ShowEditByKey(Key);
    Key := #0;
  end;
end;

procedure TcxCollectionEditor.SelectAllCommandUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := ListView1.Items.Count > 0;
end;

procedure TcxCollectionEditor.AMDeferUpdate(var Msg);
begin
  if FStateLock = 0 then
  begin
    if TMessage(Msg).WParam = 0 then
      SetSelection
    else
      ItemsModified(nil);
  end
  else
    PostMessage(Handle, AM_DeferUpdate, TMessage(Msg).WParam, TMessage(Msg).LParam);
end;

procedure TcxCollectionEditor.SelectionUpdate(Sender: TObject);
var
  Enabled: Boolean;
begin
  Enabled := ListView1.Selected <> nil;
  if Enabled then
    if Sender = acDelete then
      Enabled := coDelete in Options
    else
      if (Sender = acMoveUp) or (Sender = acMoveDown) then
        Enabled := coMove in Options;
  (Sender as TAction).Enabled := Enabled;
end;

procedure TcxCollectionEditor.SelectAll(DoUpdate: Boolean);
var
  I: Integer;
begin
  LockState;
  ListView1.Items.BeginUpdate;
  try
    for I := 0 to Listview1.Items.Count-1 do
      Listview1.Items[I].Selected := True;
  finally
    ListView1.Items.EndUpdate;
    UnlockState;
    if DoUpdate then SetSelection;
  end;
end;

procedure TcxCollectionEditor.SelectNone(DoUpdate: Boolean);
var
  I: Integer;
begin
  LockState;
  ListView1.Items.BeginUpdate;
  try
    for I := 0 to Listview1.Items.Count-1 do
      Listview1.Items[I].Selected := False;
  finally
    ListView1.Items.EndUpdate;
    UnlockState;
    if DoUpdate then SetSelection;
  end;
end;

procedure TcxCollectionEditor.CloseNonModal(AInspector: TcxCustomRTTIInspector);
begin
  CloseEditor;
end;

procedure TcxCollectionEditor.PropertyChanged(
  AInspector: TcxCustomRTTIInspector);
begin
  if FStateLock > 0 then Exit;
    ItemsModified(AInspector);
end;

function TcxCollectionEditor.CanAdd(Index: Integer): Boolean;
begin
  Result := True;
end;

procedure TcxCollectionEditor.Localize;
begin
  acAdd.Caption := cxGetResourceString(@cxSvgRTTICollectionAdd);
  acAdd.Hint := cxGetResourceString(@cxSvgRTTICollectionAddHint);
  acDelete.Caption := cxGetResourceString(@cxSvgRTTICollectionDelete);
  acDelete.Hint := cxGetResourceString(@cxSvgRTTICollectionDeleteHint);
  acSelectAll.Caption := cxGetResourceString(@cxSvgRTTICollectionSelectAll);
  acToolbar.Caption := cxGetResourceString(@cxSvgRTTICollectionToolbar);
  acTextLabels.Caption := cxGetResourceString(@cxSvgRTTICollectionTextLabel);
  acMoveUp.Caption := cxGetResourceString(@cxSvgRTTICollectionMoveUp);
  acMoveUp.Hint := cxGetResourceString(@cxSvgRTTICollectionMoveUpHint);
  acMoveDown.Caption := cxGetResourceString(@cxSvgRTTICollectionMoveDown);
  acMoveDown.Hint := cxGetResourceString(@cxSvgRTTICollectionMoveDownHint);
end;

initialization
  cxRegisterPropertyEditor(TypeInfo(TCollection), nil, '', TcxCollectionProperty);

finalization
  cxCollectionEditorsList.Free;
  cxCollectionEditorsList := nil;
end.