cxdesignwindows.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,433 行 · 第 1/3 页

function ListBoxGetFirstSelectedIndex(AListBox: TListBox): Integer;
begin
  for Result := 0 to AListBox.Items.Count - 1 do
    if AListBox.Selected[Result] then Exit;
  Result := -1;  
end;

function ListBoxGetLastSelectedIndex(AListBox: TListBox): Integer;
begin
  for Result := AListBox.Items.Count - 1 downto 0 do
    if AListBox.Selected[Result] then Exit;
  Result := -1;
end;

procedure ListBoxDeleteSelection(AListBox: TListBox; ASetFocus: Boolean);
var
  I, AIndex: Integer;
  AObject: TObject;

  function CanDeleteObject(AObject: TObject): Boolean;
  begin
    if AObject is TComponent then
      Result := not (csAncestor in TComponent(AObject).ComponentState)
    else
      Result := True;
  end;

begin
  AIndex := -1;
  for I := AListBox.Items.Count - 1 downto 0 do
    if AListBox.Selected[I] then
    begin
      with AListBox.Items do
      begin
        AObject := Objects[I];
        if not CanDeleteObject(AObject) then Continue;
        Delete(I);
      end;
      AObject.Free;
      AIndex := I;
    end;
  {for I := 0 to AListBox.Items.Count - 1 do
    if AListBox.Selected[I] then
    begin
      if AIndex = -1 then AIndex := I;
      AListBox.Items.Objects[I].Free;
    end;}
  // Show Last Item
  if AIndex >= AListBox.Items.Count then
    AIndex := AListBox.Items.Count - 1;
  if AIndex >= 0 then
  begin
    ListBoxSetItemIndex(AListBox, AIndex);
    if ASetFocus and AListBox.CanFocus then
      AListBox.SetFocus;
  end;
end;

procedure ListBoxGetSelection(AListBox: TListBox; AList: TList);
var
  I: Integer;
begin
  for I := 0 to AListBox.Items.Count - 1 do
    if AListBox.Selected[I] then
      AList.Add(AListBox.Items.Objects[I]);
end;

procedure ListBoxLoadCollection(AListBox: TListBox; ACollection: TCollection);
var
  I, AItemIndex, ATopIndex: Integer;
  ASelection: TStringList;
  S: string;
begin
  ListBoxSaveSelection(AListBox, ASelection, AItemIndex, ATopIndex);
  try
    AListBox.Items.Clear;
    for I := 0 to ACollection.Count - 1 do
    begin
      S := Format('%d - %s',[I, ACollection.Items[I].DisplayName]);
      AListBox.Items.AddObject(S, ACollection.Items[I]);
    end;
  finally
    ListBoxRestoreSelection(AListBox, ASelection, AItemIndex, ATopIndex);
  end;
end;

procedure ListBoxSelectByObject(AListBox: TListBox; AObject: TObject);
var
  AIndex: Integer;
begin
  AIndex := AListBox.Items.IndexOfObject(AObject);
  if AIndex <> -1 then
    ListBoxSetSelected(AListBox, AIndex, True);
end;

procedure ListBoxSyncSelection(AListBox: TListBox; AList: TList);
var
  I, AItemIndex, ATopIndex: Integer;
  ASelected: Boolean;
  APrevOnClick: TNotifyEvent;
begin
  ListBoxSavePos(AListBox, AItemIndex, ATopIndex);
  try
    APrevOnClick := LockListBox(AListBox);
    try
      for I := 0 to AListBox.Items.Count - 1 do
      begin
        ASelected := AList.IndexOf(AListBox.Items.Objects[I]) <> -1;
        if AListBox.Selected[I] <> ASelected then
          AListBox.Selected[I] := ASelected;
      end;
    finally
      UnlockListBox(AListBox, APrevOnClick);
    end;
    if AListBox.SelCount = 1 then
      for I := 0 to AListBox.Items.Count - 1 do
        if AListBox.Selected[I] then
        begin
          AItemIndex := I;
          Break;
        end;
  finally
    ListBoxRestorePos(AListBox, AItemIndex, ATopIndex);
  end;
end;

procedure ListBoxClearSelection(AListBox: TListBox);
var
  APrevOnClick: TNotifyEvent;
{$IFNDEF DELPHI6}
  I: Integer;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    if AListBox.MultiSelect then
      for I := 0 to AListBox.Items.Count - 1 do
        AListBox.Selected[I] := False
    else
      AListBox.ItemIndex := -1;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;
{$ELSE}
begin
  APrevOnClick := LockListBox(AListBox);
  try
    AListBox.ClearSelection;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;
{$ENDIF}

procedure ListBoxSelectAll(AListBox: TListBox);
var
  I: Integer;
  APrevOnClick: TNotifyEvent;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    with AListBox do
      for I := 0 to Items.Count - 1 do
        Selected[I] := True;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;

procedure ListBoxMoveItems(AListBox: TListBox; AIndex: Integer;
  var APrevDragIndex: Integer; AReindexProc: TcxListBoxReindexProc);
var
  I: Integer;
  APrevOnClick: TNotifyEvent;
  AList: TList;
begin
  APrevOnClick := LockListBox(AListBox);
  try
    with AListBox do
    begin
      if (0 <= APrevDragIndex) and (APrevDragIndex < Items.Count) then
      begin
        Selected[APrevDragIndex] := False;
        APrevDragIndex := -1;
      end;
      if AIndex <> -1 then
      begin
        AList := TList.Create;
        try
          for I := 0 to Items.Count - 1 do
            if Selected[I] then
              AList.Add(Items.Objects[I]);
          AReindexProc(AList, AIndex);
        finally
          AList.Free;
        end;
      end;
      AIndex := Max(ListBoxGetFirstSelectedIndex(AListBox), AIndex);
      AIndex := Min(ListBoxGetLastSelectedIndex(AListBox), AIndex);
      ItemIndex := AIndex;
    end;
  finally
    UnlockListBox(AListBox, APrevOnClick);
  end;
end;

procedure ListBoxMoveUpItems(AListBox: TListBox; var APrevDragIndex: Integer; 
  AReindexProc: TcxListBoxReindexProc);
begin
  ListBoxMoveItems(AListBox, Max(0, ListBoxGetFirstSelectedIndex(AListBox) - 1),
    APrevDragIndex, AReindexProc);
end;

procedure ListBoxMoveDownItems(AListBox: TListBox; var APrevDragIndex: Integer;
  AReindexProc: TcxListBoxReindexProc);
begin
  ListBoxMoveItems(AListBox, Min(AListBox.Items.Count - 1, ListBoxGetLastSelectedIndex(AListBox) + 1),
    APrevDragIndex, AReindexProc);
end;

procedure ListBoxDragOver(AListBox: TListBox; Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean; var APrevDragIndex: Integer);
var
  AIndex: Integer;
  APrevOnClick: TNotifyEvent;
begin
  if Source <> AListBox then
    Accept := False
  else
  begin
    APrevOnClick := LockListBox(AListBox);
    try
      with AListBox do
      begin
        Accept := True;
        AIndex := ItemAtPos(Point(X, Y), True);
        if APrevDragIndex <> AIndex then
        begin
          if (0 <= APrevDragIndex) and (APrevDragIndex < Items.Count) then
            Selected[APrevDragIndex] := False;
          if AIndex <> -1 then
            if not Selected[AIndex] then
            begin
              Selected[AIndex] := True;
              APrevDragIndex := AIndex;
            end
            else
              APrevDragIndex := -1;
        end;
        ItemIndex := AIndex;
      end;
    finally
      UnlockListBox(AListBox, APrevOnClick);
    end;
  end;
end;

procedure ListBoxDragDrop(AListBox: TListBox; Sender, Source: TObject; 
  X, Y: Integer; var APrevDragIndex: Integer; AReindexProc: TcxListBoxReindexProc);
var
  AIndex: Integer;
begin
  AIndex := AListBox.ItemAtPos(Point(X, Y), True);
  if (AIndex = -1) and PtInRect(AListBox.ClientRect, Point(X, Y)) then
    AIndex := AListBox.Items.Count;
  if AIndex <> -1 then
    ListBoxMoveItems(AListBox, AIndex, APrevDragIndex, AReindexProc);
end;

procedure ListBoxEndDrag(AListBox: TListBox; Sender, Target: TObject; 
  X, Y: Integer; var APrevDragIndex: Integer);
begin
  if (0 <= APrevDragIndex) and (APrevDragIndex < AListBox.Items.Count) then
  begin
    ListBoxSetSelected(AListBox, APrevDragIndex, False);
    APrevDragIndex := -1;
  end;
end;

// component rename routines

procedure CrunchFieldName(var AFieldName: string);
var
  I: Integer;
begin
  I := 1;
  while I <= Length(AFieldName) do
  begin
    if AFieldName[I] in ['A'..'Z','a'..'z','_','0'..'9'] then
      Inc(I)
    else
      if AFieldName[I] in LeadBytes then
        Delete(AFieldName, I, 2)
      else
        Delete(AFieldName, I, 1);
  end;
end;

function GenerateName(AOwnerComponent: TComponent;
  const AClassName, ATruncateClassName, AFieldName: string; ANumber: Integer): string;
var
  S: string;
begin
  S := AFieldName;
  CrunchFieldName(S);
  if (S = '') or (S[1] in ['0'..'9']) then
  begin
    if AClassName <> '' then
    begin
      if (ATruncateClassName <> '') and
        (CompareText(ATruncateClassName, Copy(AClassName, 1, Length(ATruncateClassName))) = 0) then
      begin
        S := Copy(AClassName, Length(ATruncateClassName) + 1, Length(AClassName)) + S;
      end
      else
      begin
        S := AClassName + S;
        if S[1] = 'T' then Delete(S, 1, 1);
      end;
    end;
  end;
  if AOwnerComponent <> nil then
    Result := AOwnerComponent.Name + S
  else
    Result := S;
  if ANumber > 0 then
    Result := Result + IntToStr(ANumber);
end;

function CreateUniqueName(AOwnerForm, AOwnerComponent, AChildComponent: TComponent;
  const ATruncateClassName, AFieldName: string): string;

  function IsUnique(const AName: string): Boolean;
  var
    I: Integer;
  begin
    Result := True;
    with AOwnerForm do
      for I := 0 to ComponentCount - 1 do
        if (Components[I] <> AChildComponent) and
          (CompareText(Components[I].Name, AName) = 0) then
        begin
          Result := False;
          Break;
        end;
  end;

var
  I, J: Integer;
begin
  if GetObjectDesigner(AOwnerForm) <> nil then
  begin
    Result := GenerateName(AOwnerComponent, AChildComponent.ClassName,
      ATruncateClassName, AFieldName, 0);
    Result := GetObjectDesigner(AOwnerForm).UniqueName(Result);
  end
  else
  begin
    if AFieldName <> '' then
      J := 0
    else
      J := 1;
    for I := J to MaxInt do
    begin
      Result := GenerateName(AOwnerComponent, AChildComponent.ClassName,
        ATruncateClassName, AFieldName, I);
      if IsUnique(Result) then
        Break;
    end;
  end;
end;

function CreateMenuItem(AOwner: TComponent; const ACaption: string;
  AOnClick: TNotifyEvent = nil; AEnabled: Boolean = True; ATag: Integer = -1;
  AChecked: Boolean = False): TMenuItem;
begin
  Result := TMenuItem.Create(AOwner);
  Result.Caption := ACaption;
  Result.Checked := AChecked;
  Result.Enabled := AEnabled;
  Result.Tag := ATag;
  Result.OnClick := AOnClick;
end;

{$IFDEF DELPHI10}  // should be DELPHI105

procedure MakeColoredControlsOpaque(ARoot: TControl);
var
  I: Integer;
begin
  if (ARoot is TPanel) and (TPanel(ARoot).Color <> clBtnFace) then
    TPanel(ARoot).ParentBackground := False;
  if ARoot is TWinControl then
    for I := 0 to TWinControl(ARoot).ControlCount - 1 do
      MakeColoredControlsOpaque(TWinControl(ARoot).Controls[I]);
end;

{$ENDIF}

{ TcxDesignHelper }

constructor TcxDesignHelper.Create(AComponent: TComponent);
begin
  inherited Create;
  FComponent := AComponent;
  FList := TList.Create;
end;

destructor TcxDesignHelper.Destroy;
begin
  FWindow.Free;
  FList.Free;
  inherited Destroy;
end;

procedure TcxDesignHelper.ChangeSelection(AObject: TPersistent);
begin
  if IsObjectSelected(AObject) then
    UnselectObject(AObject)
  else
    SelectObject(AObject, False);
end;

procedure TcxDesignHelper.GetSelection(AList: TList);
var
  ASelectionList: TDesignerSelectionList;
  I: Integer;
begin
  if Designer = nil then Exit;
  ASelectionList := CreateDesignerSelectionList;
  try
    Designer.GetSelections(ASelectionList);
    AList.Capacity := ASelectionList.Count;
    for I := 0 to ASelectionList.Count - 1 do
      AList.Add(ASelectionList[I]);
  finally
    DeleteDesignerSelectionList(ASelectionList);
  end;
end;

function TcxDesignHelper.IsObjectSelected(AObject: TPersistent): Boolean;
var
  AList: TList;
begin
  AList := TList.Create;
  try
    GetSelection(AList);
    Result := AList.IndexOf(AObject) <> -1;
  finally
    AList.Free;
  end;
end;

procedure TcxDesignHelper.SelectObject(AObject: TPersistent; AClearSelection: Boolean = True;
  AActivateOwner: Boolean = True);
var
  AList: TList;
begin
  if AClearSelection and AActivateOwner then
    Designer.SelectComponent(AObject)
  else
  begin
    AList := TList.Create;
    try
      if not AClearSelection then GetSelection(AList);
      if AList.IndexOf(AObject) = -1 then
      begin
        AList.Add(AObject);
        SetSelection(AList);
      end;
    finally
      AList.Free;
    end;
  end;
end;

procedure TcxDesignHelper.SetSelection(AList: TList);