Показать сообщение отдельно
  #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.
Ответить с цитированием