cximagelisteditor.pas

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

              AParser.NextToken;
              ConvertOrderModifier;
              AParser.TokenString;
              while not AParser.TokenSymbolIs('end') do ConvertProperty;
              AParser.NextToken;
            end;
          end;
      else
        raise Exception.Create('Convert error');
      end;
      AParser.NextToken;
    end;
  end;

  procedure ConvertProperty;
  var
    APropName: string;
  begin
    AParser.CheckToken(toSymbol);
    APropName := AParser.TokenString;
    AParser.NextToken;
    while AParser.Token = '.' do
    begin
      AParser.NextToken;
      AParser.CheckToken(toSymbol);
      APropName := APropName + '.' + AParser.TokenString;
      AParser.NextToken;
    end;
    AParser.CheckToken('=');
    AParser.NextToken;
    ConvertValue(APropName);
  end;

  procedure ConvertObject;
  var
    AInheritedObject: Boolean;
    AInlineObject: Boolean;
  begin
    AInheritedObject := False;
    AInlineObject := False;
    if AParser.TokenSymbolIs('INHERITED') then
      AInheritedObject := True
    else if AParser.TokenSymbolIs('INLINE') then
      AInlineObject := True
    else
      AParser.CheckTokenSymbol('OBJECT');
    AParser.NextToken;
    ConvertHeader(AInheritedObject, AInlineObject);
    while not AParser.TokenSymbolIs('END') and
      not AParser.TokenSymbolIs('OBJECT') and
      not AParser.TokenSymbolIs('INHERITED') and
      not AParser.TokenSymbolIs('INLINE') do
      ConvertProperty;
    while not AParser.TokenSymbolIs('END') do
      ConvertObject;
  end;

begin
  AParser := TParser.Create(AInputSteram);
  ASaveSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  try
    ConvertObject;
  finally
    DecimalSeparator := ASaveSeparator;
    AParser.Free;
  end;
end;

procedure PngImageListTocxImageList(APngImages: TComponent; AImages: TcxImageList);
var
  S, D: TMemoryStream;
begin
  S := TMemoryStream.Create;
  try
    S.WriteComponent(APngImages);
    S.Position := 0;
    D := TMemoryStream.Create;
    try
      ObjectBinaryToText(S, D);
      S.Position := 0;
      D.Position := 0;
      ProcessPngImageList(D, AImages);
    finally
      D.Free;
    end;
  finally
    S.Free;
  end;
end;

{ TcxEditorImageInfo }

procedure TcxEditorImageInfo.SetImage(Value: TBitmap);
begin
  inherited;
  FAlphaUsed := IsBitmapAlphaUsed(Image);
end;

{ TcxImageFileFormats }

procedure TcxImageFileFormats.Register(const AName, AExt: string; AGraphicClass: TGraphicClass);
begin
  SetLength(FList, Count + 1);
  FList[Count - 1].Name := AName;
  FList[Count - 1].Ext := AExt;
  FList[Count - 1].GraphicClass := AGraphicClass;
end;

function TcxImageFileFormats.GetGraphicClass(const AFileName: string): TGraphicClass;
var
  I: Integer;
  AExt: string;
begin
  Result := nil;
  AExt := ExtractFileExt(AFileName);
  for I := 0 to Count - 1 do
    if SameText(AExt, Items[I].Ext) then
      Result := Items[I].GraphicClass;
end;

function TcxImageFileFormats.GetFilter: string;
var
  I: Integer;
  AAllExtentions, AAllImages: string;
begin
  AAllExtentions := '';
  AAllImages := '';
  for I := 0 to Count - 1 do
  begin
    if AAllExtentions = '' then
      AAllExtentions := '*' + Items[I].Ext
    else
      AAllExtentions := AAllExtentions + ';*' + Items[I].Ext;
    if AAllImages = '' then
      AAllImages := Items[I].Name + '|*' + Items[I].Ext
    else
      AAllImages := AAllImages + '|' + Items[I].Name + '|*' + Items[I].Ext;
  end;
  Result := 'All supported image types|' + AAllExtentions + '|' + AAllImages;
end;

function TcxImageFileFormats.Count: Integer;
begin
  Result := Length(FList);
end;

function TcxImageFileFormats.GetItem(Index: Integer): TcxImageFileFormat;
begin
  Result := FList[Index];
end;

{ TcxImageListEditor }

constructor TcxImageListEditor.Create;
begin
  inherited Create;
  FImageList := TcxImageList.Create(nil);
  FEditorForm := TcxImageListEditorForm.Create(Self);
  FImportList := TStringList.Create;
  FVisibleImportList := TStringList.Create;

  FDataControl := TcxImageListEditorForm(FEditorForm).GetVisualDataControl;
  FDataControl.SmallImages := ImageList;
  FDataControl.LargeImages := ImageList;
  FDataControl.OnDeletion := DeleteDataItem;
  FDataControl.OnSelectItem := SelectDataItem;
end;

destructor TcxImageListEditor.Destroy;
begin
  ClearImages;
  FDataControl.OnSelectItem := nil;
  FDataControl.OnDeletion := nil;
  FDataControl := nil;
  FreeAndNil(FVisibleImportList);
  FreeAndNil(FImportList);
  FreeAndNil(FEditorForm);
  FreeAndNil(FImageList);
  inherited;
end;

function TcxImageListEditor.Edit(AImageList: TcxImagelist): Boolean;
var
  ACaption: string;
begin
  ImageList := AImageList;
  ACaption := AImageList.Name;
  if AImageList.Owner <> nil then
    ACaption := AImageList.Owner.Name + '.' + ACaption;
  FEditorForm.Caption := ACaption;
  FEditorForm.ShowModal;
  Result := FImageListModified;
end;

procedure TcxImageListEditor.AddImages(AFiles: TStrings; AAddMode: TcxImageListEditorAddMode);

  function GetImageInfoFromFile(const AFileName: string; AImageInfo: TcxImageInfo): Boolean;
  var
    AGraphic: TGraphic;
    AGraphicClass: TGraphicClass;
  begin
    AImageInfo.Image := nil;
    AImageInfo.Mask := nil;
    AImageInfo.MaskColor := clNone;
    AGraphicClass := cxImageFileFormats.GetGraphicClass(AFileName);
    Result := AGraphicClass <> nil;
    if Result then
    begin
      AGraphic := AGraphicClass.Create;
      try
        AGraphic.LoadFromFile(AFileName);
        if AGraphic is TdxPNGImage then // TODO:
          AImageInfo.Image := TdxPNGImage(AGraphic).GetAsBitmap
        else
          if AGraphic is TcxIcon then
          begin
            AGraphic.Width := ImageWidth;
            AGraphic.Height := ImageHeight;
            TcxIcon(AGraphic).GetImageInfo(AImageInfo)
          end
          else //TBitmap
            AImageInfo.Image := TBitmap(AGraphic);
      finally
        AGraphic.Free;
      end;
    end;
  end;

var
  AImageInfo: TcxImageInfo;
  I, AInsertedItemIndex: Integer;
begin
  case AAddMode of
    amAdd:
      AInsertedItemIndex := ImagesCount;
    amInsert:
      AInsertedItemIndex := Max(0, FocusedImageIndex);
  else {amReplace}
    AInsertedItemIndex := FocusedImageIndex;
    DeleteImage(AInsertedItemIndex);
  end;

  FSplitBitmaps := mrNone;
  ClearSelection;
  Application.ProcessMessages;
  AImageInfo := TcxImageInfo.Create;
  try
    for I := 0 to AFiles.Count - 1 do
      if GetImageInfoFromFile(AFiles[I], AImageInfo) then
        InternalAddImage(AImageInfo.Image, AImageInfo.Mask, AFiles[I], AInsertedItemIndex, AFiles.Count > 1);
  finally
    AImageInfo.Free;
  end;
  FocusedImageIndex := AInsertedItemIndex - 1;
end;

procedure TcxImageListEditor.ClearImages;
begin
  DataItems.Clear;
  UpdateImageList;
end;

procedure TcxImageListEditor.DeleteSelectedImages;
var
  ASelectedIndex: Integer;
  I: Integer;
begin
  if not IsAnyImageSelected then
    Exit;
  ASelectedIndex := FocusedImageIndex;
  for I := ImagesCount - 1 downto 0 do
    if DataItems[I].Selected then
      DeleteImage(I);
  FocusedImageIndex := Min(ASelectedIndex, ImagesCount - 1);
end;

procedure TcxImageListEditor.ExportImages(const AFileName: string);

  function CanReplace: Boolean;
  begin
    Result := MessageDlg(Format('File %s is already exists.' + dxEndOfLine + 
      'Do you want to replace it?',
      [AFileName]), mtWarning, [mbYes, mbNo], 0) = mrYes;
  end;
  
  procedure SelectAllImages;
  var
    I: Integer;
  begin
    for I := 0 to ImagesCount - 1 do
      DataItems[I].Selected := True;
  end;

  function GetSelectionCount: Integer;
  var
    I: Integer;
  begin
    Result := 0;
    for I := 0 to ImagesCount - 1 do
      if DataItems[I].Selected then
        Inc(Result);
  end;

var
  AImageIndex: Integer;
  ASelectedItem: TListItem;
  AExportImage: TcxBitmap;
  ARect: TRect;
begin
  if not FileExists(AFileName) or CanReplace then
  begin
    Application.ProcessMessages;
    ASelectedItem := FDataControl.Selected;
    if not IsAnyImageSelected then
      SelectAllImages;
    AExportImage := TcxBitmap.CreateSize(ImageList.Width * GetSelectionCount, ImageList.Height);
    try
      ARect := cxRect(0, 0, ImageList.Width, ImageList.Height);
      for AImageIndex := 0 to ImagesCount - 1 do
        if DataItems[AImageIndex].Selected then
        begin
          AExportImage.CopyBitmap(ImagesInfo[AImageIndex].Image, ARect, cxNullPoint);
          ARect := cxRectOffset(ARect, ImageList.Width, 0);
        end;
      AExportImage.SaveToFile(AFileName);

      FDataControl.Selected := ASelectedItem;
    finally
      AExportImage.Free;
    end;
  end;
end;

procedure TcxImageListEditor.ImportImages(AImageList: TCustomImageList);
begin
  if AImageList.Count <> 0 then
  begin
    if (AImageList.ClassName = 'TPngImageList') and CheckGdiPlus then
      PngImageListTocxImageList(AImageList, ImageList)
    else
      ImageList.CopyImages(AImageList);
    SynchronizeData(ImagesCount, AImageList.Count);
    FChanged := True;
    FocusedImageIndex := ImagesCount - 1;
  end;
  Change;
end;

function TcxImageListEditor.InternalAddImage(AImage, AMask: TBitmap; AFileName: string;
  var AInsertedItemIndex: Integer; AMultiSelect: Boolean): Integer;

  function GetUserPermissionForSplit(AFileName: string; AMultiSelect: Boolean): Boolean;
  const
    scxBitmapSplitQuery = 'The bitmap in the file %s is too large.' + dxEndOfLine +
      'Do you want to split it into smaller bitmaps?';
  var
    APossibleAnswers: TMsgDlgButtons;
  begin
    APossibleAnswers := [mbYes, mbNo];
    if AMultiSelect then
        APossibleAnswers := APossibleAnswers + [mbNoToAll, mbYesToAll];
    FSplitBitmaps := MessageDlg(Format(scxBitmapSplitQuery, [AFileName]), mtConfirmation, APossibleAnswers, 0);
    Result := FSplitBitmaps in [mrYes, mrYesToAll, mrCancel];
  end;

var
  AColCount, ARowCount, AColIndex, ARowIndex: Integer;
  ASourceImageSize: TSize;
  ASplitImages: Boolean;
  ADestBitmap, ADestMask: TBitmap;
  ADestRect: TRect;
  ASrcPoint: TPoint;
begin