cximagelisteditor.pas

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

  Result := -1;

  ASplitImages := ((AImage.Width mod ImageWidth) + (AImage.Height mod ImageHeight)) = 0;

  if ((AImage.Width = ImageWidth) and (AImage.Height = ImageHeight)) or
    ASplitImages and
    (FSplitBitmaps <> mrNoToAll) and
    ((FSplitBitmaps = mrYesToAll) or GetUserPermissionForSplit(AFileName, AMultiSelect)) then
    ASourceImageSize := cxSize(ImageWidth, ImageHeight)
  else
    ASourceImageSize := cxSize(AImage.Width, AImage.Height);

  AColCount := AImage.Width div ASourceImageSize.cx;
  ARowCount := AImage.Height div ASourceImageSize.cy;

  ADestBitmap := cxCreateBitmap(ImageWidth, ImageHeight, pf32bit);

  if IsGlyphAssigned(AMask) then
    ADestMask := cxCreateBitmap(ImageWidth, ImageHeight, pf1bit)
  else
    ADestMask := nil;
  try
    ADestRect := Rect(0, 0, ImageWidth, ImageHeight);
    for ARowIndex := 0 to ARowCount - 1 do
      for AColIndex := 0 to AColCount - 1 do
      begin
        ASrcPoint := Point(AColIndex * ASourceImageSize.cx, ARowIndex * ASourceImageSize.cy);
        cxDrawBitmap(ADestBitmap.Canvas.Handle, AImage, ADestRect, ASrcPoint);
        if IsGlyphAssigned(AMask) then
          cxDrawBitmap(ADestMask.Canvas.Handle, AMask, ADestRect, ASrcPoint);
        AddImage(ADestBitmap, ADestMask, GetDefaultTransparentColor(ADestBitmap, ADestMask), AInsertedItemIndex);
      end;
  finally
    ADestMask.Free;
    ADestBitmap.Free;
  end;
end;

procedure TcxImageListEditor.MoveImage(ASourceImageIndex, ADestImageIndex: Integer);
var
  AList: TList;
  I: Integer;
begin
  if ADestImageIndex <> ASourceImageIndex then
  begin
    AList := TList.Create;
    try
      for I := 0 to ImagesCount - 1 do
        AList.Add(DataItems[I].Data);
      AList.Move(ASourceImageIndex, ADestImageIndex);
      for I := 0 to ImagesCount - 1 do
        DataItems[I].Data := AList[I];
    finally
      AList.Free;
    end;
    FocusedImageIndex := ADestImageIndex;
  end;
  UpdateImageList;
end;

function TcxImageListEditor.IsAnyImageSelected: Boolean;
begin
  Result := (FocusedImageIndex <> -1) and (FDataControl.SelCount > 0);
end;

procedure TcxImageListEditor.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TcxImageListEditor.EndUpdate;
begin
  if FUpdateCount > 0 then
    Dec(FUpdateCount);
end;

function TcxImageListEditor.IsUpdateLocked: Boolean;
begin
  Result := FUpdateCount > 0;
end;

procedure TcxImageListEditor.ApplyChanges;
begin
  if IsChanged then
  begin
    FOriginalImageList.Width := ImageWidth;
    FOriginalImageList.Height := ImageHeight;
    AddDataItems(FOriginalImageList);
    //FOriginalImageList.Assign(ImageList);
    FImageListModified := True;
    FChanged := False;
  end;
  Change;
end;

function TcxImageListEditor.IsChanged: Boolean;
begin
  Result := FChanged;
end;

procedure TcxImageListEditor.UpdateTransparentColor(AColor: TColor);
var
  I: Integer;
begin
  for I := 0 to ImagesCount - 1 do
    if DataItems[I].Selected and (ImagesInfo[I].MaskColor <> AColor) then
    begin
      ImagesInfo[I].MaskColor := AColor;
      UpdateImageList;
    end;
end;

function TcxImageListEditor.ChangeImagesSize(AValue: TSize): Boolean;

  function CanChangeImagesSize: Boolean;
  begin
    Result := MessageDlg('This will change the image dimensions and remove all the existing images from the list. Do you want to proceed?',
      mtWarning, [mbYes, mbNo], 0) = mrYes;
  end;

begin
  Result := False;
  if ((ImageWidth <> AValue.cx) or (ImageHeight <> AValue.cy)) and
    ((ImagesCount = 0) or CanChangeImagesSize) then
    begin
      Result := True;
      ImageList.Width := AValue.cx;
      ImageList.Height := AValue.cy;
      UpdateVisibleImportList;
      ClearImages;
    end;
end;

procedure TcxImageListEditor.SynchronizeData(AStartIndex, ACount: Integer);
var
  I: Integer;
  AImageInfo: TcxEditorImageInfo;
begin
  for I := AStartIndex to AStartIndex + ACount - 1 do
  begin
    AImageInfo := TcxEditorImageInfo.Create;
    TcxImageListAccess(ImageList).GetImageInfo(I, AImageInfo);
    DataItems.Add.Data := AImageInfo;
  end;
  UpdateImageList;
end;

procedure TcxImageListEditor.AddDataItems(AImageList: TcxImagelist);
var
  I: Integer;
begin
  AImageList.BeginUpdate;
  try
    AImageList.Clear;
    for I := 0 to ImagesCount - 1 do
      TcxImageListAccess(AImageList).AddImageInfo(ImagesInfo[I]);
  finally
    AImageList.EndUpdate;
  end;
end;

procedure TcxImageListEditor.AddImage(AImage, AMask: TBitmap; AMaskColor: TColor; var AInsertedImageIndex: Integer);
var
  AImageInfo: TcxEditorImageInfo;
begin
  AImageInfo := TcxEditorImageInfo.Create;
  AImageInfo.Image := AImage;
  AImageInfo.Mask := AMask;
  AImageInfo.MaskColor := AMaskColor;
  DataItems.Add.Data := AImageInfo;
  MoveImage(ImagesCount - 1, AInsertedImageIndex);
  Inc(AInsertedImageIndex);
end;

procedure TcxImageListEditor.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TcxImageListEditor.ClearSelection;
var
  I: Integer;
begin
  for I := 0 to ImagesCount - 1 do
    DataItems[I].Selected := False;
end;

procedure TcxImageListEditor.DeleteDataItem(Sender: TObject; Item: TListItem);
begin
  TObject(Item.Data).Free;
end;

procedure TcxImageListEditor.DeleteImage(AIndex: Integer);
begin
  if IsIndexValid(AIndex, ImagesCount) then
  begin
    DataItems.Delete(AIndex);
    UpdateImageList;
  end;
end;

function TcxImageListEditor.GetImagesCount: Integer;
begin
  Result := DataItems.Count;
end;

function TcxImageListEditor.GetDefaultTransparentColor(AImage, AMask: TBitmap): TColor;
begin
  if IsGlyphAssigned(AMask) or IsBitmapAlphaUsed(AImage) then
    Result := clNone
  else
    Result := AImage.Canvas.Pixels[0, AImage.Height - 1];
end;

function TcxImageListEditor.GetFocusedImageIndex: Integer;
begin
  Result := -1;
  if FDataControl.ItemFocused <> nil then
    Result := FDataControl.ItemFocused.Index;
end;

function TcxImageListEditor.GetImageHeight: Integer;
begin
  Result := ImageList.Height;
end;

function TcxImageListEditor.GetImagesInfo(Index: Integer): TcxEditorImageInfo;
begin
  Result := nil;
  if IsIndexValid(Index, ImagesCount) then
    Result := TcxEditorImageInfo(DataItems[Index].Data);
end;

procedure TcxImageListEditor.SetImageList(AValue: TcxImageList);
begin
  FOriginalImageList := AValue;
  ImageList.Assign(AValue);
  SynchronizeData(0, ImageList.Count);
  FChanged := False;
  FocusedImageIndex := 0;
  UpdateVisibleImportList;
end;

function TcxImageListEditor.GetImageWidth: Integer;
begin
  Result := ImageList.Width;
end;

procedure TcxImageListEditor.ImageListChanged;

  procedure InitializeListViewItem(AIndex: Integer);
  begin
    DataItems[AIndex].Caption := IntToStr(AIndex);
    DataItems[AIndex].ImageIndex := AIndex;
  end;

var
  I: Integer;
begin
  for I := 0 to ImagesCount - 1 do
    InitializeListViewItem(I);
  FChanged := True;
  Change;
end;

procedure TcxImageListEditor.SelectDataItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Selected then
    FDataControl.ItemFocused := Item;
end;

function TcxImageListEditor.GetDataItems: TListItems;
begin
  Result := FDataControl.Items;
end;

procedure TcxImageListEditor.SetFocusedImageIndex(AValue: Integer);
begin
  if IsIndexValid(AValue, ImagesCount) then
  begin
    ClearSelection;
    DataItems[AValue].Selected := True;
    FDataControl.Selected.MakeVisible(True);
  end;
end;

procedure TcxImageListEditor.SetImagesInfo(Index: Integer;
  AValue: TcxEditorImageInfo);
begin
  if DataItems[Index].Data <> AValue then
    DataItems[Index].Data := AValue;
end;

procedure TcxImageListEditor.SetImportList(AValue: TStrings);
begin
  if AValue <> nil then
    FImportList.Assign(AValue)
  else
    FImportList.Clear;
end;

procedure TcxImageListEditor.UpdateImageList;

  procedure MakeSystemBackground(ASource, ADestination: TBitmap);
  var
    R: TRect;
  begin
    R := Rect(0, 0, ADestination.Width, ADestination.Height);
    ADestination.Canvas.Brush.Color := clWindow;
    ADestination.Canvas.FillRect(R);
    cxAlphaBlend(ADestination, ASource, R, R);
  end;

var
  I: Integer;
  AImageInfo: TcxImageInfo;
  AEditorImageInfo: TcxEditorImageInfo;
begin
  ImageList.BeginUpdate;
  try
    ImageList.Clear;
    AImageInfo := TcxImageInfo.Create;
    try
      for I := 0 to ImagesCount - 1 do
      begin
        AEditorImageInfo := ImagesInfo[I];
        if AEditorImageInfo.AlphaUsed and not IsXPManifestEnabled then
        begin
          AImageInfo.Assign(AEditorImageInfo);
          MakeSystemBackground(AEditorImageInfo.Image, AImageInfo.Image);
          TcxImageListAccess(ImageList).AddImageInfo(AImageInfo);
        end
        else
          TcxImageListAccess(ImageList).AddImageInfo(AEditorImageInfo);
      end;
    finally
      AImageInfo.Free;
    end;
  finally
    ImageList.EndUpdate;
  end;
  ImageListChanged;
end;

procedure TcxImageListEditor.UpdateVisibleImportList;
var
  I: Integer;
  ACustomImageList: TCustomImageList;
begin
  FVisibleImportList.Clear;
  for I := 0 to FImportList.Count - 1 do
  begin
    ACustomImageList := TCustomImageList(FImportList.Objects[I]);
    if (ACustomImageList.Width = ImageWidth) and (ACustomImageList.Height = ImageHeight) then
      FVisibleImportList.AddObject(FImportList[I], FImportList.Objects[I]);
  end;
  TcxImageListEditorForm(FEditorForm).SetImportList(FVisibleImportList);
  Change;
end;

initialization
  FImageFileFormats := TcxImageFileFormats.Create;
  cxImageFileFormats.Register('Bitmaps (*.bmp)', '.bmp', TBitmap);
  cxImageFileFormats.Register('Icons (*.ico)', '.ico', TcxIcon);
  if GetClass(TdxPNGImage.ClassName) <> nil then
    cxImageFileFormats.Register('DevExpress PNG (*.png)', '.png', TdxPNGImage);

finalization
  FreeAndNil(FImageFileFormats);

end.