cdibimagelist.pas

Delphi控件

      FDIB.BeginUpdate;
      Filename := GetFilename(FDIB.ImageFilename);
      FDIB.ImportPicture(Filename);
      if FDIB.MaskFilename <> '' then
      begin
        Filename := GetFilename(FDIB.MaskFilename);
        FDIB.ImportMask(Filename);
      end;
      FDIBLoaded := True;
    finally
      FDIB.EndUpdate;
    end;
  end;
end;

{ TDIBImages }

function TDIBImages.Add: TDIBImagesItem;
begin
  Result := TDIBImagesItem(inherited Add);
end;

function TDIBImages.AddTemplate(const GUID: string;
  const Index: Integer): TDIBImagesItem;
var
  I, Position: Integer;
  SearchString: string;
begin
  Position := -1;
  SearchString := GUID + ':' + IntToStr(Index);
  
  for I := 0 to Count - 1 do 
  begin
    if Items[I].FImportedFrom = SearchString then 
    begin
      Position := I;
      break;
    end;
  end;

  if Position > -1 then
    Result := Items[Position]
  else 
  begin
    Result := Add;
    Result.FImportedFrom := GUID + ':' + IntToStr(Index);
  end;
end;

constructor TDIBImages.Create(AOwner: TComponent; AClass: TDIBImagesItemClass);
begin
  inherited Create(AOwner, AClass);
  FOwner := AOwner;
end;

destructor TDIBImages.Destroy;
begin
  inherited;
end;

function TDIBImages.FindItemByName(AName: string): TDIBImagesItem;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if AnsiCompareText(Items[I].DisplayName, AName) = 0 then
    begin
      Result := Items[I];
      Break;
    end;
end;

function TDIBImages.GetItem(Index: Integer): TDIBImagesItem;
begin
  Result := TDIBImagesItem(inherited GetItem(Index));
end;

procedure TDIBImages.ImageChanged(Index: Integer; Operation: TDIBOperation);
begin
  if FOwner is TCustomDIBImageList then
    TCustomDIBImageList(FOwner).ImageChanged(Self, Index, Operation);
end;

procedure TDIBImages.ImageMoved(FromIndex, ToIndex: Integer);
begin
  if FOwner is TCustomDIBImageList then
    TCustomDIBImageList(FOwner).ImageMoved(FromIndex, ToIndex);
end;

function TDIBImages.ItemByName(AName: string): TDIBImagesItem;
begin
  Result := FindItemByName(AName);
  if Result = nil then
    raise EDIBImageListError.Create('Item ' + AName + ' not found');
end;

procedure TDIBImages.SetItem(Index: Integer; Value: TDIBImagesItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TDIBImages.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
end;

{ TCustomDIBImageList }

procedure TCustomDIBImageList.AddLink(Link: TDIBImageLink);
var
  Index: Integer;
begin
  if Link = nil then exit;
  if FLinkList.IndexOf(Link) < 0 then FLinkList.Add(Link);
  if DIBImages <> nil then
    for Index := 0 to DIBImages.Count - 1 do Link.ListChanged(Index, doChange);
end;

constructor TCustomDIBImageList.Create(AOwner: TComponent);
begin
  inherited;
  FDIBImages := TDIBImages.Create(Self, GetItemClass);
  FDuplicateDIB := TMemoryDIB.Create(1, 1);
  FUniqueDIB := TMemoryDIB.Create(1, 1);
  FLinkList := TList.Create;
end;

destructor TCustomDIBImageList.Destroy;
var
  X: Integer;
begin
  for X := FLinkList.Count - 1 downto 0 do
    TDIBImageLink(FLinkList[X]).UnlinkNotification;
  FDIBImages.Free;
  FLinkList.Free;
  FUniqueDIB.Free;
  FDuplicateDIB.Free;
  inherited;
end;

function TCustomDIBImageList.Get(Index: Integer): TMemoryDIB;
begin
  Result := FDuplicateDIB;
  Result.PointDataAt(DIBImages.Items[Index].DIB);
end;

function TCustomDIBImageList.GetUnique(Index: Integer): TMemoryDIB;
begin
  FUniqueDIB.Assign(DIBImages.Items[Index].DIB);
  Result := FUniqueDIB;
end;

procedure TCustomDIBImageList.ImageChanged(Sender: TObject; Index: Integer;
  Operation: TDIBOperation);
var
  X: Integer;
begin
  for X := 0 to FLinkList.Count - 1 do TDIBImageLink(FLinkList[X]).ListChanged(Index,
      Operation);
end;

procedure TCustomDIBImageList.ImageMoved(FromIndex, ToIndex: Integer);
var
  Index: Integer;
begin
  if FromIndex < ToIndex then
  begin
    for Index := 0 to FLinkList.Count - 1 do
      with TDIBImageLink(FLinkList[Index]) do
        if FDIBIndex = FromIndex then
          FDIBIndex := ToIndex
    else if (FromIndex < FDIBIndex) and (FDIBIndex <= ToIndex) then
      Dec(FDIBIndex);
  end
  else 
  begin
    for Index := 0 to FLinkList.Count - 1 do
      with TDIBImageLink(FLinkList[Index]) do
        if FDIBIndex = FromIndex then
          FDIBIndex := ToIndex
    else if (ToIndex <= FDIBIndex) and (FDIBIndex < FromIndex) then
      Inc(FDIBIndex);
  end;
end;

function TCustomDIBImageList.GetImage(Index: Integer;
  var ResultPic: TMemoryDIB): Boolean;
var
  TheDIB: TMemoryDIB;
begin
  Result := False;
  if Self = nil then exit;
  if (Index < 0) or (Index >= DIBImages.Count) then exit;
  TheDIB := DIBImages.Items[Index].DIB;
  if not TheDIB.Valid then exit;

  ResultPic := Get(Index);
  Result := True;
end;

function TCustomDIBImageList.IsIndexValid(Index: Integer): Boolean;
begin
  Result := False;
  if Self = nil then exit;
  if (Index < 0) or (Index >= DIBImages.Count) then exit;
  Result := True;
end;

procedure TCustomDIBImageList.RemoveLink(Link: TDIBImageLink);
var
  Index: Integer;
begin
  if Link = nil then exit;

  Index := FLinkList.IndexOf(Link);
  if Index >= 0 then 
  begin
    FLinkList.Delete(Index);
    //    if DIBImages <> nil then
    //      for Index := 0 to DIBImages.Count-1 do
    //        Link.ListChanged(Index, doRemove);
  end;
end;

function TCustomDIBImageList.ImageByName(DisplayName: string): TMemoryDIB;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to DIBImages.Count - 1 do
    if CompareText(DisplayName, DIBImages[I].DisplayName) = 0 then
    begin
      Result := DIBImages[I].DIB;
      Break;
    end;
end;

function TCustomDIBImageList.GetItemClass: TDIBImagesItemClass;
begin
  Result := TDIBImagesItem;
end;

procedure TCustomDIBImageList.Loaded;
var
  I: Integer;
begin
  inherited;
  for I := 0 to DIBImages.Count - 1 do
    if DIBImages[I].ImageRetrieval = irLoadOnStart then
      DIBImages[I].ImportImages;
end;

{ TDIBImageLink }

procedure TDIBImageLink.AssignTo(Dest: TPersistent);
begin
  if Dest is TDIBImageLink then with TDIBImageLink(Dest) do 
    begin
      DIBIndex := Self.DIBIndex;
      DIBImageList := Self.DIBImageList;
    end 
  else
    inherited;
end;

constructor TDIBImageLink.Create(AOwner: TComponent);
begin
  inherited Create;
  FOwner := AOwner;
  FDIBIndex := -1;
end;

destructor TDIBImageLink.Destroy;
begin
  if DIBImageList <> nil then DIBImageList.RemoveLink(Self);
  inherited;
end;

function TDIBImageLink.GetImage(var ResultPic: TMemoryDIB): Boolean;
begin
  Result := False;
  if Self = nil then exit;
  //  if not Assigned(DIBImageList) then
  //    raise EDIBImageListError.Create('Image list has not been assigned');
  Result := DIBImageList.GetImage(DIBIndex, ResultPic);
end;

procedure TDIBImageLink.ListChanged(Index: Integer; Operation: TDIBOperation);
begin
  if (Operation = doChange) and (Index <> DIBIndex) then exit;
  if (Operation = doRemove) and (Index > DIBIndex) then exit;

  if FOwner <> nil then
    if csDestroying in FOwner.ComponentState then exit;

  //If removing a list item which is < this one, we don't need an update,
  //we just change our index number
  if Operation = doRemove then
    if Index < DIBIndex then 
    begin
      FDIBIndex := FDIBIndex - 1;
      exit;
    end;

  if Assigned(FOnImageChanged) then FOnImageChanged(Self, Index, Operation);
  if (Operation = doRemove) and (Index = DIBIndex) then FDIBIndex := -1;
end;

procedure TDIBImageLink.SetDIBImageIndex(const Value: Integer);
var
  OldIndex: Integer;
begin
  OldIndex := FDIBIndex;
  FDIBIndex := Value;
  if (OldIndex <> Value) then ListChanged(Value, doChange);
end;

procedure TDIBImageLink.SetDIBImageList(const Value: TCustomDIBImageList);
begin
  if FDIBImageList <> nil then FDIBImageList.RemoveLink(Self);
  FDIBImageList := Value;
  if FDIBImageList <> nil then FDIBImageList.AddLink(Self);
end;

procedure TDIBImageLink.UnlinkNotification;
begin
  DIBImageList := nil;
end;

function TDIBImageLink.Valid: Boolean;
begin
  Result := FDIBImageList.IsIndexValid(DIBIndex);
end;

end.