Delphi. Алгоритмы. Галерея своими руками или как выложить плитками фрэйм

Давно хотел записать это, так как часто пригождается, думаю транслировать на другие языки не составит труда. Итак, вот что у нас получится…

Я пока не стал выкладывать никакие картинки, просто хочу здесь описать саму логику алгоритма. Сам алгоритм я взял в книге Дмитрия Осипова по FireMonkey и немного адаптировал под свою задачу.

Итак, пусть есть N картинок заданного размера. Я создал отдельный объект фиксированного размера TPictureFrame и им выложил галерею так, чтобы если плитка не входит – она перемещалась бы на следующий ряд. Саму плитку раскрасил белым и окантовал серым.

Алгоритм выкладывания плиток

procedure TGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;
var x,y,PictureWidth,PictureHeight:integer;
    i:Integer;

begin

//Assert(FPictureFramesOL.Count>0,' Fill FPictureFramesOL first! It is empty ');

if FPictureFramesOL.Count=0 then Exit;


   // initial coordinates

   PictureWidth:=TPictureFrame(FPictureFramesOL[0]).Width;
   PictureHeight:=TPictureFrame(FPictureFramesOL[0]).Height;

   x:=-PictureWidth+10;
   y:=1;




   for i := 0 to FPictureFramesOL.Count-1 do begin

    // moving horizontally

    Inc(x,PictureWidth); // adding width

    if x+PictureWidth<Self.ClientWidth then begin

     TPictureFrame(FPictureFramesOL[i]).Left:=x;
     TPictureFrame(FPictureFramesOL[i]).Top:=y;

     TPictureFrame(FPictureFramesOL[i]).Parent:=Self;
     TPictureFrame(FPictureFramesOL[i]).Show;


    end else

    // moving vertically

    // new row
    begin

      x:=10;
      Inc(y,PictureHeight); // adding height

      TPictureFrame(FPictureFramesOL[i]).Left:=x;
      TPictureFrame(FPictureFramesOL[i]).Top:=y;

     TPictureFrame(FPictureFramesOL[i]).Parent:=Self;
     TPictureFrame(FPictureFramesOL[i]).Show;

     Self.Height:=y+PictureHeight+5;



    end;





   end;





end;

procedure TGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;

var x,y,PictureWidth,PictureHeight:integer;

i:Integer;

begin

//Assert(FPictureFramesOL.Count>0,' Fill FPictureFramesOL first! It is empty ');

if FPictureFramesOL.Count=0 then Exit;

// initial coordinates

PictureWidth:=TPictureFrame(FPictureFramesOL[0]).Width;

PictureHeight:=TPictureFrame(FPictureFramesOL[0]).Height;

x:=-PictureWidth+10;

y:=1;

for i := 0 to FPictureFramesOL.Count-1 do begin

// moving horizontally

Inc(x,PictureWidth); // adding width

if x+PictureWidth<Self.ClientWidth then begin

TPictureFrame(FPictureFramesOL[i]).Left:=x;

TPictureFrame(FPictureFramesOL[i]).Top:=y;

TPictureFrame(FPictureFramesOL[i]).Parent:=Self;

TPictureFrame(FPictureFramesOL[i]).Show;

end else

// moving vertically

// new row

begin

x:=10;

Inc(y,PictureHeight); // adding height

TPictureFrame(FPictureFramesOL[i]).Left:=x;

TPictureFrame(FPictureFramesOL[i]).Top:=y;

TPictureFrame(FPictureFramesOL[i]).Parent:=Self;

TPictureFrame(FPictureFramesOL[i]).Show;

Self.Height:=y+PictureHeight+5;

end;

Алгоритм достаточно простой – выкладываем в ширину, и если не влезло переносим на следующий ряд. Сами плитки находятся в ObjectList и загружаются туда отдельно.

Вот полный код модуля

unit uGalleryOfPictureFrames;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,System.Contnrs,uPictureFrame;

type
  TGalleryOfPictureFrames = class(TFrame)
  private
    { Private declarations }

    FPictureFramesOL:TObjectList;

    FCounterForUnqiueName:integer;

  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;
    property PictureFramesOL:TObjectList read FPictureFramesOL write FPictureFramesOL;

    function AddPictureFrame():integer;

    procedure DisposePicturesOnGalleryFrame;

  end;

implementation

{$R *.dfm}

uses uMainVisualFrame;
var MainVisualFrame_UnitVar:TMainVisualFrame;


{ TGalleryOfPicturesFrames }

function TGalleryOfPictureFrames.AddPictureFrame:integer;
begin

 Result:=FPictureFramesOL.Add( TPictureFrame.Create(Self) );
 TPictureFrame(FPictureFramesOL[FPictureFramesOL.Count-1]).Name:='someUniqueName'+
 FCounterForUnqiueName.ToString;

 Inc(FCounterForUnqiueName);

end;

constructor TGalleryOfPictureFrames.Create(AOwner: TComponent);
begin
  inherited;

    if (AOwner is TMainVisualFrame) then
    MainVisualFrame_UnitVar:=(AOwner as TMainVisualFrame);

    FPictureFramesOL:=TObjectList.Create;
    FPictureFramesOL.OwnsObjects:=True;

    FCounterForUnqiueName:=0;

end;

procedure TGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;
var x,y,PictureWidth,PictureHeight:integer;
    i:Integer;

begin

//Assert(FPictureFramesOL.Count>0,' Fill FPictureFramesOL first! It is empty ');

if FPictureFramesOL.Count=0 then Exit;


   // initial coordinates

   PictureWidth:=TPictureFrame(FPictureFramesOL[0]).Width;
   PictureHeight:=TPictureFrame(FPictureFramesOL[0]).Height;

   x:=-PictureWidth+10;
   y:=1;




   for i := 0 to FPictureFramesOL.Count-1 do begin

    // moving horizontally

    Inc(x,PictureWidth); // adding width

    if x+PictureWidth<Self.ClientWidth then begin

     TPictureFrame(FPictureFramesOL[i]).Left:=x;
     TPictureFrame(FPictureFramesOL[i]).Top:=y;

     TPictureFrame(FPictureFramesOL[i]).Parent:=Self;
     TPictureFrame(FPictureFramesOL[i]).Show;


    end else

    // moving vertically

    // new row
    begin

      x:=10;
      Inc(y,PictureHeight); // adding height

      TPictureFrame(FPictureFramesOL[i]).Left:=x;
      TPictureFrame(FPictureFramesOL[i]).Top:=y;

     TPictureFrame(FPictureFramesOL[i]).Parent:=Self;
     TPictureFrame(FPictureFramesOL[i]).Show;

     Self.Height:=y+PictureHeight+5;



    end;





   end;





end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

unit uGalleryOfPictureFrames;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,System.Contnrs,uPictureFrame;

type

TGalleryOfPictureFrames = class(TFrame)

private

{ Private declarations }

FPictureFramesOL:TObjectList;

FCounterForUnqiueName:integer;

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

property PictureFramesOL:TObjectList read FPictureFramesOL write FPictureFramesOL;

function AddPictureFrame():integer;

procedure DisposePicturesOnGalleryFrame;

end;

implementation

{$R *.dfm}

uses uMainVisualFrame;

var MainVisualFrame_UnitVar:TMainVisualFrame;

{ TGalleryOfPicturesFrames }

function TGalleryOfPictureFrames.AddPictureFrame:integer;

begin

Result:=FPictureFramesOL.Add( TPictureFrame.Create(Self) );

TPictureFrame(FPictureFramesOL[FPictureFramesOL.Count-1]).Name:='someUniqueName'+

FCounterForUnqiueName.ToString;

Inc(FCounterForUnqiueName);

end;

constructor TGalleryOfPictureFrames.Create(AOwner: TComponent);

begin

inherited;

if (AOwner is TMainVisualFrame) then

MainVisualFrame_UnitVar:=(AOwner as TMainVisualFrame);

FPictureFramesOL:=TObjectList.Create;

FPictureFramesOL.OwnsObjects:=True;

FCounterForUnqiueName:=0;

end;

procedure TGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;

var x,y,PictureWidth,PictureHeight:integer;

i:Integer;

begin

//Assert(FPictureFramesOL.Count>0,' Fill FPictureFramesOL first! It is empty ');

if FPictureFramesOL.Count=0 then Exit;

// initial coordinates

PictureWidth:=TPictureFrame(FPictureFramesOL[0]).Width;

PictureHeight:=TPictureFrame(FPictureFramesOL[0]).Height;

x:=-PictureWidth+10;

y:=1;

for i := 0 to FPictureFramesOL.Count-1 do begin

// moving horizontally

Inc(x,PictureWidth); // adding width

if x+PictureWidth<Self.ClientWidth then begin

TPictureFrame(FPictureFramesOL[i]).Left:=x;

TPictureFrame(FPictureFramesOL[i]).Top:=y;

TPictureFrame(FPictureFramesOL[i]).Parent:=Self;

TPictureFrame(FPictureFramesOL[i]).Show;

end else

// moving vertically

// new row

begin

x:=10;

Inc(y,PictureHeight); // adding height

TPictureFrame(FPictureFramesOL[i]).Left:=x;

TPictureFrame(FPictureFramesOL[i]).Top:=y;

TPictureFrame(FPictureFramesOL[i]).Parent:=Self;

TPictureFrame(FPictureFramesOL[i]).Show;

Self.Height:=y+PictureHeight+5;

end;

end.

Вызов из главного модуля

procedure TMainVisualFrame.LoadFirstPage;
var
  LastAddedIndex:integer;

begin

DBPagination.LoadFirstPage(); // << opens query, load records

{
for i := 0  to DBPagination.RecordsOnPage-1 do begin
//  FGalleryOfPicturesFrames

end;
}

  with FQueries.qSelectAllFilesOfUser do begin


   while not EOF  do begin

     LastAddedIndex:=FGalleryOfPictureFrames.AddPictureFrame;

     with TPictureFrame(FGalleryOfPictureFrames.PictureFramesOL[LastAddedIndex])
     do begin

     // do something here with frames

     end;

   Next();
   end;




  end;


     FGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;

end;

procedure TMainVisualFrame.LoadFirstPage;

var

LastAddedIndex:integer;

begin

DBPagination.LoadFirstPage(); // << opens query, load records

{

for i := 0 to DBPagination.RecordsOnPage-1 do begin

// FGalleryOfPicturesFrames

end;

}

with FQueries.qSelectAllFilesOfUser do begin

while not EOF do begin

LastAddedIndex:=FGalleryOfPictureFrames.AddPictureFrame;

with TPictureFrame(FGalleryOfPictureFrames.PictureFramesOL[LastAddedIndex])

do begin

// do something here with frames

end;

Next();

end;

FGalleryOfPictureFrames.DisposePicturesOnGalleryFrame;

end;

Ну и модуль фрэйма, в котором мы берем PaintBox и на его Canvas рисуем белым, а кантуем его серым.

unit uPictureFrame;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TPictureFrame = class(TFrame)
    PaintBox: TPaintBox;
    procedure FrameClick(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);


  private
    { Private declarations }

    procedure PaintBorder();

  public
    { Public declarations }

     constructor Create(AOwner: TComponent); override;

  end;

implementation

{$R *.dfm}

constructor TPictureFrame.Create(AOwner: TComponent);
begin
  inherited;

//

end;

procedure TPictureFrame.FrameClick(Sender: TObject);
begin

//



end;

procedure TPictureFrame.PaintBorder;
begin


PaintBox.Canvas.Pen.Color:=$A4A0A0;
PaintBox.Canvas.MoveTo(5,5);
PaintBox.Canvas.LineTo(5,Self.ClientHeight-5);
PaintBox.Canvas.MoveTo(5,5);
PaintBox.Canvas.LineTo(Self.ClientWidth-5,5);
PaintBox.Canvas.MoveTo(Self.ClientWidth-5,ClientHeight-5);
PaintBox.Canvas.LineTo(5,ClientHeight-5);
PaintBox.Canvas.MoveTo(Self.ClientWidth-5,ClientHeight-5);
PaintBox.Canvas.LineTo(Self.ClientWidth-5,5);

end;

procedure TPictureFrame.PaintBoxPaint(Sender: TObject);
begin

PaintBox.Canvas.Brush.Color:=clWhite;
PaintBox.Canvas.FillRect(PaintBox.Canvas.ClipRect);
PaintBorder;

end;

end.

unit uPictureFrame;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,

Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type

TPictureFrame = class(TFrame)

PaintBox: TPaintBox;

procedure FrameClick(Sender: TObject);

procedure PaintBoxPaint(Sender: TObject);

private

{ Private declarations }

procedure PaintBorder();

public

{ Public declarations }

constructor Create(AOwner: TComponent); override;

end;

implementation

{$R *.dfm}

constructor TPictureFrame.Create(AOwner: TComponent);

begin

inherited;

end;

procedure TPictureFrame.FrameClick(Sender: TObject);

begin

end;

procedure TPictureFrame.PaintBorder;

begin

PaintBox.Canvas.Pen.Color:=$A4A0A0;

PaintBox.Canvas.MoveTo(5,5);

PaintBox.Canvas.LineTo(5,Self.ClientHeight-5);

PaintBox.Canvas.MoveTo(5,5);

PaintBox.Canvas.LineTo(Self.ClientWidth-5,5);

PaintBox.Canvas.MoveTo(Self.ClientWidth-5,ClientHeight-5);

PaintBox.Canvas.LineTo(5,ClientHeight-5);

PaintBox.Canvas.MoveTo(Self.ClientWidth-5,ClientHeight-5);

PaintBox.Canvas.LineTo(Self.ClientWidth-5,5);

end;

procedure TPictureFrame.PaintBoxPaint(Sender: TObject);

begin

PaintBox.Canvas.Brush.Color:=clWhite;

PaintBox.Canvas.FillRect(PaintBox.Canvas.ClipRect);

PaintBorder;

end;

end.

Delphi. Алгоритмы. Галерея своими руками или как выложить плитками фрэйм

Алгоритм выкладывания плиток

MY PROJECTS

Recent Posts

Categories