Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 22.09.2023, 12:21
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Лампочка Ошибка SavePicture

Здравствуйте! ошибка строка 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);
Ответить с цитированием
  #2  
Старый 22.09.2023, 12:31
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Стрелка 1

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.
Ответить с цитированием
  #3  
Старый 22.09.2023, 17:49
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 8,035
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
По умолчанию

И что за ошибка?
[Telepath mode on]
А случаем в AValue не должно ли передаваться имя файла? А то по твоему коду там сейчас передается пустая строка. Ну и сохранить файл с таким именем действительно сложновато будет
[Telepath mode off]
Ответить с цитированием
  #4  
Старый 22.09.2023, 19:45
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Сообщение готовый пример

я взял готовый пример. Pictures111.zip но когда запускаю редактор, как будто чего то не хватает.
Ответить с цитированием
  #5  
Старый 22.09.2023, 19:47
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Стрелка

error2a.jpg
error3a.jpg
в первой ошибки, второй ЕХЕ с демки
Ответить с цитированием
  #6  
Старый 22.09.2023, 20:17
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
По умолчанию готово

в USES нужно добавить cxImage, тогда пропадает ошибка в строке 225 SavePicture(APicture, AVariantValue);
Ответить с цитированием
  #7  
Старый 23.09.2023, 07:39
leon2009 leon2009 вне форума
Новичок
 
Регистрация: 18.03.2009
Сообщения: 71
Репутация: 10
Плохо готово

Код:
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 -> или картинки не будут показаны
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:13.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter