1

多数のTPanelを作成できるTScrollBoxを含む複合コンポーネントを作成しようとしています。TPanelsにはコントロールがありますが、最も重要なのはTImagesです。Columnsプロパティは、いつ新しい行にドロップするかを決定します。以下のコードを参照してください。現在、1つのTPanelを追加できますが、別のTPanelを追加すると、StackOverflowエラーが発生します

パネルは、Imagesプロパティ(TStringList)を介して追加されます。Stringlists ListChangedイベントは、パネラをクリアし、再更新します。

アプリケーションから、私はそのように画像を広告することができます:

if OpenPictureDialog1.Execute then
 TViewer1.Images.Add(OpenPictureDialog1.FileName)

私はコンポーネントに慣れていないので、私には簡単です:)

unit TViewer;

type
  TViewer = class(TCustomPanel)
  private
    { Private declarations }
    fScrollBox: TScrollBox;
    fColumns: Integer;
    fImages : TStrings;
    fThumbWidth: Integer;
    fThumbHeight: Integer;
    procedure SetColumns(Value: Integer);
    procedure SetImages(Value: TStrings);
    procedure SetThumbWidth(Value: Integer);
    procedure SetThumbHeight(Value: Integer);
    function GetColumns: Integer;
    function GetThumbWidth: Integer;
    function GetThumbHeight: Integer;
  protected
    { Protected declarations }
    procedure LinesChanged(Sender: TObject);
    procedure UpdateViewer;
    procedure ClearViewer;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
  published
    { Published declarations }
     property Align;
     property Columns : Integer read GetColumns write SetColumns default 5;
     property Images  : TStrings read fImages write SetImages;
     property ThumbHeight: Integer read GetThumbHeight write SetThumbHeight default 100;
     property ThumbWidth: Integer read GetThumbWidth write SetThumbWidth default 100;
  end;

procedure Register;

implementation

procedure TViewer.ClearViewer;
var
 I: Integer;
begin
 for I := fScrollBox.ComponentCount-1 downTo 0 do
   TPanel(self.Components[I]).Free;
end;

procedure TViewer.UpdateViewer;
var
 I,X,Y,C, D: Integer;
 Thumb: TPanel;
 img: TImage;
 begin
 ClearViewer;
  //update thumnails
  X:= 0;
  Y:= 0;
  C:= 0;
  D:= 5;
  Thumb:= nil;
  for I := 0 to fimages.Count - 1 do
  begin
   if fileExists(fimages[I]) then
   begin
     //create a panel
     Thumb:= TPanel.Create(fScrollBox);
     Thumb.Parent:= fScrollBox;
     Thumb.Caption:= '';
     Thumb.Left:= X + D;
     Thumb.Top:= Y + D;
     Thumb.Width:= fThumbWidth;
     Thumb.Height:= fThumbHeight;

     //create Image
     img:= TImage.Create(Thumb);
     img.Parent:= Thumb;
     img.Align:= alClient;
     img.Stretch:= true;
     img.Picture.LoadFromFile(fImages[I]);
   end;
   X:= X + Thumb.Width + D;
   if C = fColumns then
   begin
     X:= 0;
     Y:= Y + Thumb.Height + D;
   end;
   inc(C);
  end;
end;


procedure TViewer.SetImages(Value: TStrings);
begin
  fImages.Assign(Value);
  // update viewer
  UpdateViewer;
end;

procedure TViewer.SetColumns(Value: Integer);
begin
 if fColumns <> value then
  fColumns:= Value;
end;

procedure TViewer.SetThumbWidth(Value: Integer);
begin
 if fThumbWidth <> Value  then
  fThumbWidth:= Value;
end;
procedure TViewer.SetThumbHeight(Value: Integer);
begin
 if fThumbHeight <> Value  then
  fThumbHeight:= Value;
end;

function TViewer.GetColumns: Integer;
begin
 result:= fColumns;
end;

function TViewer.GetThumbWidth: Integer;
begin
  result:= fThumbWidth;
end;

function TViewer.GetThumbHeight: Integer;
begin
  result:= fThumbHeight;
end;

procedure TViewer.LinesChanged(Sender: TObject);
begin
  //update viewer
  UpdateViewer;
end;

constructor TViewer.Create(AOwner: TComponent);
begin
  inherited Create(aOwner);
  ControlStyle := ControlStyle - [csSetCaption];
  fImages := TStringList.Create;
  TStringList(fImages).OnChange := LinesChanged;
  fThumbHeight:= 100;
  fThumbWidth:= 100;
  fColumns:= 5;
  //add scrollbar
  fScrollBox:= TScrollBox.Create(self);
  fScrollBox.Parent:= self;
  fScrollBox.Align:= alClient;
  fScrollBox.VertScrollBar.Visible:= True;
  fScrollBox.HorzScrollBar.Visible:= True;
end;

destructor TViewer.Destroy;
begin
  fImages.Free;
  inherited;
end;


procedure Register;
begin
  RegisterComponents('Custom', [TViewer]);
end;

end.
4

1 に答える 1

2

で間違ったリストを変更していますが、そうClearViewer()SelfはありませんfScrollBox

for I := fScrollBox.ComponentCount-1 downTo 0 do
  TPanel(self.Components[I]).Free;
于 2013-03-12T13:02:30.117 に答える