aoutlbar.pas

来自「delphi编程控件」· PAS 代码 · 共 2,084 行 · 第 1/5 页

PAS
2,084 行
字号
begin
  if (FSmallImage <> Value) then begin
    FSmallImage := Value;
    if(FStore <> Nil) then
      FStore.UpdateItem(self);
  end;
end;

procedure TAutoOutLookStoredItem.SetStore(Value : TAutoOutLookBarStore);
begin
  if(FStore <> Value) then begin
    if(FStore <> Nil) then
      FStore.RemoveItem(self);
    FStore := Value;
    if(FStore <> Nil) then begin
      FStore.AddItem(self);
      if Not (csLoading in ComponentState) then
        Category := 0;
    end;
  end;
end;

{TAutoOutLookBarStore}
constructor TAutoOutLookBarStore.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FList := TList.Create;
  FBars := TList.Create;
  FCategories := TAutoOutLookStoredItemsStoreStrings.Create(self);
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := OnChangeLink;
  FDefaultLargeImage := -1;
  FDefaultSmallImage := -1;  

  Designer := Nil;
end;

destructor TAutoOutLookBarStore.Destroy;
begin
  LargeImages := Nil;
  SmallImages := Nil;
  FChangeLink.Free;
  {$IFDEF INCLUDE_DESIGNTIME}
  if(Designer <> Nil) then
    CloseAutoOutLookBarStoreEditor(self);
  {$ENDIF}
  DestroyItems;
  FCategories.Free;
  FBars.Free;
  FList.Free;
  inherited Destroy;
end;

procedure TAutoOutLookBarStore.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then begin
    if (AComponent = LargeImages) then LargeImages := nil;
    if (AComponent = SmallImages) then SmallImages := nil;
  end;
end;

procedure TAutoOutLookBarStore.DestroyItems;
var
  Item: TAutoOutLookStoredItem;
begin
  while FList.Count > 0 do
  begin
    Item := FList.Last;
    RemoveItem(Item);
    Item.Free;
  end;
end;

{$IFDEF DELPHI3_0}
procedure TAutoOutLookBarStore.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].Owner = Root then Proc(Items[i]);
end;
{$ELSE}
procedure TAutoOutLookBarStore.GetChildren(Proc: TGetChildProc);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].Owner <> self then Proc(Items[i]);
end;
{$ENDIF}

procedure TAutoOutLookBarStore.SetName(const Value: TComponentName);
var
  i: Integer;
  OldName, ItemName, NamePrefix: TComponentName;
  item: TAutoOutLookStoredItem;
begin
  OldName := Name;
  inherited SetName(Value);
  if (csDesigning in ComponentState) and (Name <> OldName) then
    for I := 0 to Count - 1 do begin
      item := Items[I];
      if item.Owner = Owner then begin
        itemName := item.Name;
        NamePrefix := itemName;
        if Length(NamePrefix) > Length(OldName) then begin
          SetLength(NamePrefix, Length(OldName));
          if CompareText(OldName, NamePrefix) = 0 then begin
            System.Delete(itemName, 1, Length(OldName));
            System.Insert(Value, itemName, 1);
            try
              item.Name := itemName;
            except
              on EComponentError do
            end;
          end;
        end;
      end;
    end;
end;

function TAutoOutLookBarStore.GetCount : Integer;
begin
  Result := FList.Count;
end;

function TAutoOutLookBarStore.GetOutLookBarCount : Integer;
begin
  Result := FBars.Count;
end;

function TAutoOutLookBarStore.GetItem(Index : Integer) : TAutoOutLookStoredItem;
begin
  if(Index > -1) And (Index < Count) then
    Result := TAutoOutLookStoredItem(FList[INdex])
  else Result := Nil;
end;

function TAutoOutLookBarStore.GetOutLookBar(Index : Integer) : TAutoOutLookBar;
begin
  Result := Nil;
  if(Index > -1) And (Index < FBars.Count) then
    Result := TAutoOutLookBar(FBars[Index]);
end;

procedure TAutoOutLookBarStore.SetCategories(Value : TStrings);
Var
  i : Integer;
begin
  if(Value.Count = 0) then begin
    Categories.Clear;
    exit;
  end;
  if(Value.Count < FCategories.Count) then begin
    for i := Value.Count to FCategories.Count - 1 do
      if(GetCountByCategory(FCategories[i]) > 0) then begin
        raise EAutoOutLookBarError.Create(LoadStr(AE_OLB_CANTDELETEGROUP));
        exit;
      end;
    while Value.Count < Categories.Count do
       FCategories.Delete(FCategories.Count - 1);
  end else begin
    for i := FCategories.Count to Value.Count - 1 do
       FCategories.Add(Value[i]);
  end;
    for i := 0 to Value.Count - 1 do
       FCategories[i]:= Value[i];
end;

procedure TAutoOutLookBarStore.SetDefaultLargeImage(Value : Integer);
begin
  if(Value >= -1) And (FDefaultLargeImage <> Value) then begin
    FDefaultLargeImage := Value;
    RedrawBars;
  end;
end;

procedure TAutoOutLookBarStore.SetDefaultSmallImage(Value : Integer);
begin
  if(Value >= -1) And (FDefaultSmallImage <> Value) then begin
    FDefaultSmallImage := Value;
    RedrawBars;
  end;
end;

procedure TAutoOutLookBarStore.SetLargeImages(Value : TImageList);
begin
  if(FLargeImages <> Value) then begin
    if(FLargeImages <> Nil) And Not (csDestroying in  FLargeImages.ComponentState) then
      FLargeImages.UnRegisterChanges(FChangeLink);
    FLargeImages := Value;
    if(FLargeImages <> Nil) then
      FLargeImages.RegisterChanges(FChangeLink);
    if Not (csDestroying in  ComponentState) then
      RedrawBars;
  end;
end;

procedure TAutoOutLookBarStore.SetSmallImages(Value : TImageList);
begin
  if(FSmallImages <> Value) then begin
    if(FSmallImages <> Nil) And Not (csDestroying in  FSmallImages.ComponentState) then
      FSmallImages.UnRegisterChanges(FChangeLink);
    FSmallImages := Value;
    if(FSmallImages <> Nil) then
      FSmallImages.RegisterChanges(FChangeLink);
    if Not (csDestroying in  ComponentState) then
      RedrawBars;
  end;
end;

function TAutoOutLookBarStore.GetCountByCategory(St : String) : Integer;
Var
  Index, i : Integer;
begin
  Result := 0;
  Index := FCategories.IndexOf(St);
  if(Index > -1) then
    for i := 0 to Count - 1 do
      if(Items[i].Category = Index) then
        Inc(Result);
end;

function TAutoOutLookBarStore.GetItemByCategory(St : String; Index : Integer) : TAutoOutLookStoredItem;
Var
  List : TList;
begin
  Result := Nil;
  List := TList.Create;
  GetItemsByCategory(St, List);
  if(Index < List.Count) then
    Result := TAutoOutLookStoredItem(List[Index]);
  List.Free;
end;

function TAutoOutLookBarStore.GetItemsByCategory(St : String; List : TList) : Integer;
Var
  Index, i : Integer;
begin
  List.Clear;
  Index := FCategories.IndexOf(St);
  if(Index > -1) then
    for i := 0 to Count - 1 do
      if(Items[i].Category = Index) then
        List.Add(Items[i]);
  Result := List.Count;
end;

procedure TAutoOutLookBarStore.AddItem(Item : TAutoOutLookStoredItem);
begin
  FList.Add(Item);
end;

procedure TAutoOutLookBarStore.ExchangeItems(Item1, Item2 : TAutoOutLookStoredItem);
Var
  Index1, Index2 : Integer;
begin
  Index1 := FList.IndexOf(Item1);
  Index2 := FList.IndexOf(Item2);
  if(Index1 > -1) And (Index2 > -1) then
    FList.Exchange(Index1, Index2);
end;

procedure TAutoOutLookBarStore.RemoveItem(Item : TAutoOutLookStoredItem);
begin
  RemoveBarItem(Item);
  FList.Remove(Item);
end;

procedure TAutoOutLookBarStore.OnChangeLink(Sender : TObject);
begin
  RedrawBars;
end;

procedure TAutoOutLookBarStore.RedrawBars;
Var
  i : Integer;
begin
  for i := 0 to FBars.Count - 1 do
    OutLookBars[i].Repaint;
end;

procedure TAutoOutLookBarStore.RemoveBarItem(StoredItem : TAutoOutLookStoredItem);
Var
  i, j, k : Integer;
begin
  for i := 0 to FBars.Count - 1 do
    for j := 0 to OutLookBars[i].Groups.Count - 1 do begin
       k := 0;
       while k < OutLookBars[i].Groups[j].Items.Count do begin
         if(OutLookBars[i].Groups[j].Items[k].StoredItem = StoredItem) then
           OutLookBars[i].Groups[j].Items[k].Free
         else Inc(k);
       end;
    end;
end;

procedure TAutoOutLookBarStore.UpdateItem(Item : TAutoOutLookStoredItem);
begin
  RedrawBars;
  {$IFDEF INCLUDE_DESIGNTIME}
  UpdateEditorItem(Item);
  {$ENDIF}
end;

procedure TAutoOutLookBarStore.Customize;
begin
  AutoOutLookBarCustomize(self);
end;

{$IFDEF INCLUDE_DESIGNTIME}
procedure TAutoOutLookBarStore.UpdateEditorItem(Item : TAutoOutLookStoredItem);
begin
  if(Designer <> Nil) And (csDesigning in ComponentState) then
   AutoOutLookBarStoreEditorUpdateItem(Item);
end;
{$ENDIF}

{TAutoOutLookItem}
constructor TAutoOutLookItem.Create(Collection : TCollection);
begin
  inherited Create(Collection);
  FIsDefault := True;
  FTextHeight := 0;
end;

destructor TAutoOutLookItem.Destroy;
Var
  IsSelectedFlag : Boolean;
  Bar : TAutoOutLookBar;
begin
  IsSelectedFlag := False;
  Bar := TAutoOutLookItems(Collection).AutoOutLookBar;
  if(Bar <> Nil) And  Not (csDestroying in Bar.ComponentState)then begin
    if (Bar.IsEditing) then
      Bar.EndEdit(False);
    if(Bar.FSelectedItem = self) then
      IsSelectedFlag := True;
    if(Bar.FMouseFocusedItem = self) then
      Bar.FMouseFocusedItem := Nil;
  end;
  if (Bar <> Nil) And Assigned(Bar.FOnDeleteItem) then
    Bar.FOnDeleteItem(Bar, self);
  inherited Destroy;
  if(IsSelectedFlag) then
    Bar.SetSelectedItem(Nil);
end;

procedure TAutoOutLookItem.Assign(Source: TPersistent);
Var
  item : TAutoOutLookItem;
begin
  if(Source is TAutoOutLookItem) then begin
    item := TAutoOutLookItem(Source);
    FStoredItem := item.StoredItem;
    FHint := item.Hint;
    FIsDefault := item.IsDefault;
    FCaption := item.Caption;
    FTag := item.Tag;
    FCustomData := item.CustomData;
    FLargeImage := item.LargeImage;
    FSmallImage := item.SmallImage;
  end else inherited Assign(Source);
end;

function TAutoOutLookItem.MakeVisible;
Var
  Group : TAutoOutLookGroup;
begin
  Group := TAutoOutLookItems(Collection).Group;
  Result := FVisible And Group.Active;
  if Not Result And Group.Active then
    Group.TopVisibleItem :=
    TAutoOutLookItems(Collection).AutoOutLookBar.GetTopVisibleToMakeItemVisible(Index);
end;

function TAutoOutLookItem.GetCaption : String;
begin
  if(FStoredItem <> Nil) And IsDefault then
    Result := FStoredItem.Caption
  else Result := FCaption;
end;

function TAutoOutLookItem.GetHint : String;
begin
  if(FStoredItem <> Nil) And IsDefault then
    Result := FStoredItem.Hint
  else Result := FHint;
end;

function TAutoOutLookItem.GetGroup : TAutoOutLookGroup;
begin
  if(Collection <> Nil) then
   Result := TAutoOutLookItems(Collection).Group
  else Result := Nil;
end;

function TAutoOutLookItem.GetLargeImage : Integer;
begin
  if(FStoredItem <> Nil) And IsDefault then
    Result := FStoredItem.LargeImage
  else Result := FLargeImage;
end;

function TAutoOutLookItem.GetSmallImage : Integer;
begin
  if(FStoredItem <> Nil) And IsDefault then
    Result := FStoredItem.SmallImage
  else Result := FSmallImage;
end;

procedure TAutoOutLookItem.SetCaption(Value : String);
Var
  ABar : TAutoOutLookBar;
begin

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?