Ошибка SavePicture

leon2009 · #1 22.09.2023, 12:21

Здравствуйте! ошибка строка 225 - это как отдельный модуль?

Код:

var
   AValue: string;
   APicture: TPicture;
   sExt: string;
   function FileExtIsGraphicFileType(const aFileName: string): boolean;
   var
      lExt: string;
   begin
      lExt := '*' + ExtractFileExt(aFileName);
      //lExt should be formatted as '*.jpeg' rather than '.jpeg' or 'jpeg'
      result := Pos( AnsiLowerCase(lExt), GraphicFilter(TGraphic) ) > 0;
   end;
begin
   AValue := '';
   if FileExists(aFileName) and FileExtIsGraphicFileType(aFileName) then
   begin
      APicture := TPicture.Create;
      try
         APicture.LoadFromFile(AFileName);
       SavePicture(APicture, AValue);
      finally
         FreeAndNil(APicture);
      end;
   end;

   sExt := ExtractFileExt(aFileName);
   if (sExt = '.jpg') then
      ADataController.Values[ARecordIndex, APictureJPGColumnIndex] := AValue
   else if (sExt = '.bmp') then
      ADataController.Values[ARecordIndex, APictureBMPColumnIndex] := AValue
   else if (sExt = '.png') then
      ADataController.Values[ARecordIndex, APicturePNGColumnIndex] := AValue;
end;

SavePicture(APicture, AValue);

leon2009 · #2 22.09.2023, 12:31

screen1a.jpg скрин сделал

Код:

unit MainForm;

interface

uses
    Windows
  , Messages, SysUtils, Classes, Graphics, Controls, Forms
  , Dialogs
  , FileCtrl, ExtDlgs, StdCtrls, ExtCtrls, cxGridLevel, cxClasses,
  cxControls, cxGridCustomView, cxGridCustomTableView, cxGridTableView,
  cxGridDBTableView
  , cxGrid, cxInplaceContainer, cxTL, ImgList, cxGraphics
  , cxLookAndFeels
  , cxCustomData

  , cxImage, cxButtons, cxContainer, cxEdit, cxTextEdit, cxMaskEdit,
  cxGridCardView, cxNavigator, cxStyles, cxLookAndFeelPainters, dxSkinsCore,
  dxSkinBasic, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel,
  dxSkinCoffee, dxSkinDarkroom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
  dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast,
  dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
  dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
  dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
  dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
  dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinOffice2016Colorful,
  dxSkinOffice2016Dark, dxSkinOffice2019Black, dxSkinOffice2019Colorful,
  dxSkinOffice2019DarkGray, dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven,
  dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
  dxSkinSpringtime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
  dxSkinTheBezier, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
  dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
  dxSkinXmas2008Blue, Vcl.Menus, cxFilter, cxData, cxDataStorage, dxDateRanges,
  dxScrollbarAnnotations, cxCheckBox, cxGridCustomLayoutView
  ;

type
  TMForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    glImagesGrid: TcxGridLevel;
    cxGrid1: TcxGrid;
    lblDirectory: TLabel;
    meNewName: TcxMaskEdit;
    btnRename: TcxButton;
    meNewNumber: TcxMaskEdit;
    btnRefresh: TcxButton;
    btnDir: TcxButton;
    Memo1: TMemo;
    tvImage: TcxGridTableView;
    Chkbox: TcxGridColumn;
    Name: TcxGridColumn;
    NameWPath: TcxGridColumn;
    Date: TcxGridColumn;
    ImageBMP: TcxGridColumn;
    ImageJPG: TcxGridColumn;
    ImagePNG: TcxGridColumn;
    RecNo: TcxGridColumn;
    glImageCard: TcxGridLevel;
    cvImageCard: TcxGridCardView;
    cvRowNo: TcxGridCardViewRow;
    cvChkBox: TcxGridCardViewRow;
    cvNameWPath: TcxGridCardViewRow;
    cvImage: TcxGridCardViewRow;
    Panel3: TPanel;
    cxGrid2Level1: TcxGridLevel;
    cxGrid2: TcxGrid;
    cxGrid2CardView2: TcxGridCardView;
    cxGrid2CardView2Row1: TcxGridCardViewRow;
    cxGrid2CardView2Row2: TcxGridCardViewRow;
    cxNavigator1: TcxNavigator;
    cxStyleRepository1: TcxStyleRepository;
    GridTableViewStyleSheetDevExpress: TcxGridTableViewStyleSheet;
    cxStyle1: TcxStyle;
    cxStyle2: TcxStyle;
    cxStyle3: TcxStyle;
    cxStyle4: TcxStyle;
    cxStyle5: TcxStyle;
    cxStyle6: TcxStyle;
    cxStyle7: TcxStyle;
    cxStyle8: TcxStyle;
    cxStyle9: TcxStyle;
    cxStyle10: TcxStyle;
    cxStyle11: TcxStyle;
    cxStyle12: TcxStyle;
    cxStyle13: TcxStyle;
    cxStyle14: TcxStyle;
    GridCardViewStyleSheetDevExpress: TcxGridCardViewStyleSheet;
    cxStyle15: TcxStyle;
    cxStyle16: TcxStyle;
    cxStyle17: TcxStyle;
    cxStyle18: TcxStyle;
    cxStyle19: TcxStyle;
    cxStyle20: TcxStyle;
    cxStyle21: TcxStyle;
    cxStyle22: TcxStyle;
    cxStyle23: TcxStyle;
    cxStyle24: TcxStyle;
    SavePicture: TSavePictureDialog;
      procedure btnDirClick(Sender: TObject);
      procedure btnRefreshClick(Sender: TObject);
      procedure LoadData();
      procedure UpdateRecordPictureByFileName(  ADataController: TcxCustomDataController;
                                                AFileName: string;
                                                ARecordIndex,
                                                APictureBMPColumnIndex,
                                                APictureJPGColumnIndex,
                                                APicturePNGColumnIndex: Integer);
      procedure btnRenameClick(Sender: TObject);
      procedure RenameSelection();


  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  MForm: TMForm;

implementation

{$R *.DFM}


procedure TMForm.btnDirClick(Sender: TObject);
var
   sDir : string;
begin
   SelectDirectory('Select the dir', '', sDir);

   lblDirectory.Caption := sDir;

   LoadData();

  //RenameSelection();
end;


procedure TMForm.btnRefreshClick(Sender: TObject);
begin
   LoadData();
end;

procedure TMForm.LoadData();
var
  Path, AFileName    : String;
  SR      : TSearchRec;
  iCount : integer;

   procedure ClearGrid();
   begin
      with tvImage.DataController do
      begin
         BeginUpdate;
         try
            while RecordCount > 0 do
               DeleteRecord(0);
         finally
            EndUpdate;
         end;
      end;
   end;
begin
    Path:=lblDirectory.caption; //Get the path of the selected file

    ClearGrid();
    tvImage.BeginUpdate;
    if FindFirst(Path+'\*.*', faArchive, SR) = 0 then
    begin
         iCount := -1;
         repeat
            iCount := iCount + 1;
            with (tvImage.DataController) do
            begin
               RecordCount := iCount+1;
               Values[iCount, RecNo.Index] := RecordCount;
               Values[iCount, Chkbox.Index] := TRUE;
               Values[iCount, Name.Index] := SR.Name;

               AFileName := Path + '\' + SR.Name;
               Values[iCount, NamewPath.Index] := AFileName;

               Values[iCount, Date.Index] := DateTimeToStr(FileDateToDatetime(SR.Time));

               UpdateRecordPictureByFileName(tvImage.DataController, AFileName, iCount, ImageBMP.Index, ImageJPG.Index, ImagePNG.Index);
            end; //endof with
         until FindNext(SR) <> 0;
         FindClose(SR);
    end;

    tvImage.ApplyBestFit;
    tvImage.EndUpdate;
end;


procedure TMForm.UpdateRecordPictureByFileName( ADataController: TcxCustomDataController;
                                                AFileName: string;
                                                ARecordIndex,
                                                APictureBMPColumnIndex,
                                                APictureJPGColumnIndex,
                                                APicturePNGColumnIndex: Integer);
var
   AValue: string;
   APicture: TPicture;
   sExt: string;
   function FileExtIsGraphicFileType(const aFileName: string): boolean;
   var
      lExt: string;
   begin
      lExt := '*' + ExtractFileExt(aFileName);
      //lExt should be formatted as '*.jpeg' rather than '.jpeg' or 'jpeg'
      result := Pos( AnsiLowerCase(lExt), GraphicFilter(TGraphic) ) > 0;
   end;
begin
   AValue := '';
   if FileExists(aFileName) and FileExtIsGraphicFileType(aFileName) then
   begin
      APicture := TPicture.Create;
      try
         APicture.LoadFromFile(AFileName);
         SavePicture(APicture, AValue);
      finally
         FreeAndNil(APicture);
      end;
   end;

   sExt := ExtractFileExt(aFileName);
   if (sExt = '.jpg') then
      ADataController.Values[ARecordIndex, APictureJPGColumnIndex] := AValue
   else if (sExt = '.bmp') then
      ADataController.Values[ARecordIndex, APictureBMPColumnIndex] := AValue
   else if (sExt = '.png') then
      ADataController.Values[ARecordIndex, APicturePNGColumnIndex] := AValue;
end;


procedure TMForm.btnRenameClick(Sender: TObject);
begin
{
   if (meNewName.Text = '') or (meNewNumber.Text = '') then
   begin
      ShowMessage('Either the New Name or Number is missing. Please specify this information.');
      exit;
   end;

   RenameSelection();
}
end;

procedure TMForm.RenameSelection();
var I: integer;
begin
{
   Memo1.Lines.Clear;
   with tvImage.DataController do
      for I := 0 to RecordCount - 1 do
      begin
         if Values[I, Chkbox.Index] = True then
            Memo1.Lines.Add('Line ' + inttostr(I) + ' is ticked. ' + Values[I, 1] + '    ' + Values[I,2])
         else
            Memo1.Lines.Add('Line ' + inttostr(I) + ' is NOT ticked. ' + Values[I, 1] + '    ' + Values[I,2]);
      end;
}
end;


end.

lmikle · #3 22.09.2023, 17:49

И что за ошибка?
[Telepath mode on]
А случаем в AValue не должно ли передаваться имя файла? А то по твоему коду там сейчас передается пустая строка. Ну и сохранить файл с таким именем действительно сложновато будет
[Telepath mode off]

leon2009 · #4 22.09.2023, 19:45

я взял готовый пример. Pictures111.zip но когда запускаю редактор, как будто чего то не хватает.

leon2009 · #5 22.09.2023, 19:47

error2a.jpg
error3a.jpg
в первой ошибки, второй ЕХЕ с демки

leon2009 · #6 22.09.2023, 20:17

в USES нужно добавить cxImage, тогда пропадает ошибка в строке 225 SavePicture(APicture, AVariantValue);

leon2009 · #7 23.09.2023, 07:39

Код:

var
   i: Integer;
   path, filename: String;

  AColumn: TcxGridColumn;
  AValue: AnsiString;

  APicture: TPicture;
  MS: TMemoryStream;
  pngimage: TPNGImage;
  APath: String;

begin
AColumn := TcxGridColumn(cxGrid1DBTableView1Filename);
if assigned(AColumn)
then begin
     cxGrid1DBTableView1.DataController.RecordCount := FileListBox1.Items.Count;

     for i:=0 to FileListBox1.Items.Count -1
     do begin
        filename := IncludeTrailingPathDelimiter(GetCurrentDir) + FileListBox1.Items[i];
        AColumn := TcxGridColumn(cxGrid1DBTableView1Filename);
        if assigned(AColumn)
           then cxGrid1DBTableView1.DataController.Values[i, AColumn.Index] := ExtractFilename(filename);

        AColumn := TcxGridColumn(cxGrid1DBTableView1logo);
        if assigned(AColumn)
        then begin
             APicture := TPicture.Create;
             try
                if FileExists(filename)
                then begin
                     //pngimage.LoadFromFile(filename);
                     APicture.LoadFromFile(filename);
                     SavePicture(APicture, AValue);
                     end
                     else AValue := '';
                finally
                APicture.Free;
                end;

             if assigned(AColumn) and (AValue <> '')
             then begin
                  cxGrid1DBTableView1.DataController.Values[i, AColumn.Index] := AValue;
                  end;
             end;
        end;
     end;

единственное с чем еще столкнулся это cxGrid1DBTableView1Logo там в properties -> graficclassname установить SmartImage -> или картинки не будут показаны

Страдалецъ · #8 24.09.2023, 19:40

Посмотрите внимательно на 100 строку вашего кода. У вас конфликт имен возник. Вы умудрились создать свойство формы SavePicture с тем же именем, что и сторонний метод SavePicture.

leon2009 · #9 25.09.2023, 17:50

А как в место цифр иконки установить?

пр: в ячейке 1 = значит одна иконка или
в ячейке 2 (integer) = значить две иконки

error4a.jpg

Код:

if (AViewInfo.Item <> cxGrid1DBTableView1reviews) or
    not (AViewInfo.EditViewInfo is TcxCustomTextEditViewInfo) then
      Exit;
  APainter := TcxPainterAccess(TcxViewInfoAcess(AViewInfo).GetPainterClass.
    Create(ACanvas, AViewInfo));
   // AImageRect := AViewInfo.Bounds;
  try
    AEditViewInfo := TcxCustomTextEditViewInfo(AViewInfo.EditViewInfo);
    AEditViewInfo.TextRect.Left := AEditViewInfo.TextRect.Left + AViewInfo.
      ContentBounds.Height + 1;
    APainter.DrawContent;
    APainter.DrawBorders;

    AImageRect := AViewInfo.ContentBounds;
    AImageRect.Width := AImageRect.Height;

  If (AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index] < 0)
      Then begin
  ACanvas.DrawImage(cxImageList1, AImageRect.Left, AImageRect.Top, 0); end;

  If (AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index] < 1)
      Then begin
  ACanvas.DrawImage(cxImageList1, AImageRect.Left, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 16, AImageRect.Top, 0); end;

  If (AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index] < 2)
      Then begin
  ACanvas.DrawImage(cxImageList1, AImageRect.Left, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 16, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 32, AImageRect.Top, 0); end;

  If (AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index] < 3)
      Then begin
  ACanvas.DrawImage(cxImageList1, AImageRect.Left, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 16, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 32, AImageRect.Top, 0);
  ACanvas.DrawImage(cxImageList1, AImageRect.Left + 48, AImageRect.Top, 0); end;

  finally
    APainter.Free;
  end;
  ADone := True;

а то получается иконки просто закрашивают символы 1,2,3,4,5

lmikle · #10 25.09.2023, 22:56

Ну ты же перерисовываешь ячейку самостоятельно.
Соответсвенно, если ты хочешь видеить и цифры тоже (т.е. что то типа "3***", то надо сначала вывести саму цифру с помощью TextOut, а потом уже отрисовать иконки с соотв. смещением.

ЗЫ. Да, и твой код можно оптимизировать.

Код:

var
  StarsCount : Integer;
  I : Integer;
begin
  ...
  StarsCount := AViewInfo.GridRecord.Values[cxGrid1DBTableView1reviews.Index];
  For I := 0 To StarsCount-1 Do
    ACanvas.DrawImage(cxImageList1, AImageRect.Left+(I*16), AImageRect.Top, 0);
  ...

Т.е. какая цифра стоит в ячейке, столько звездочек и нарисует. Т не нужна эта пачка if'ов.

leon2009 · #11 26.09.2023, 14:45

я не хочу видеть цифры

error5a.jpg

lmikle · #12 26.09.2023, 21:15

Ну так не рисуй их.
У тебя там где-то вызов DrawContent - закомментируй его. Только тогда, возможно, нужно будет самому почистить соотв. облась (нарисовать прямоугольник цветом фона на весь AImageRect.

leon2009 · #13 27.09.2023, 05:05

это не честно, покрасить ячейки.
за вывод как я понял отвечает ClientDataSet и за данные

lmikle · #14 27.09.2023, 09:25

Еще раз - закоментируй вызов APainter.DrawContent;
Если вылезут артефакты при отрисовке, то вместо APainter.DrawContent; надо просто нарисовать прямоугольник цветом фона на размер ячейки (ACanvas.FillRect(AViewInfo.ContentBounds));.

leon2009 · #15 27.09.2023, 17:19

Код:

try
   { AEditViewInfo := TcxCustomTextEditViewInfo(AViewInfo.EditViewInfo);
    AEditViewInfo.TextRect.Left := AEditViewInfo.TextRect.Left + AViewInfo.ContentBounds.Height + 1;}
    //APainter.DrawContent;
    //APainter.DrawBorders;
    (ACanvas.FillRect(AViewInfo.ContentBounds)); //закрашивает ячейку

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо Страдалецъ за это полезное сообщение:
leon2009 (25.09.2023)

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
leon2009 (26.09.2023)

Этот пользователь сказал Спасибо lmikle за это полезное сообщение:
leon2009 (27.09.2023)