Delphi 模拟分页效果控件批量赋值

最新推荐文章于 2021-04-05 04:54:05 发布

ceaningking

最新推荐文章于 2021-04-05 04:54:05 发布

阅读量543

点赞数

本文链接：https://blog.csdn.net/ceaningking/article/details/105945377

版权

1. 设计界面 12个显示模板每个模板两个TImage(一个头像, 一个性别), 一个TLabel(姓名).

命名带有一定规律:

头像的TImage的Name从 img_01 ~ img_12

性别的TImage的Name从 isex_01 ~ isex_12

姓名的TLable的Name从 lbl_01 ~ lbl_12

2. 新建单元uVar.pas

unit uVar;

interface

uses
  SysUtils, Forms;

type
  TAppParams = class
  public
    class function AppPath: string;
    class function AppName: string;
  end;

  TFilePath= class(TAppParams)
  public
    class function PngPath: string;
    class function ImgPath: string;
  end;

implementation

{ TAppPara }

class function TAppParams.AppName: string;
begin
  Result := ExtractFileName(Application.ExeName);
end;

class function TAppParams.AppPath: string;
begin
  Result := ExtractFilePath(Application.ExeName);
end;

{ TFilePath }

class function TFilePath.ImgPath: string;
begin
  Result := AppPath + 'imgs\';
end;

class function TFilePath.PngPath: string;
begin
  Result := AppPath + 'png\';
end;

end.

3. 新建uObj.pas单元

unit uObj;

interface

uses
  Classes, SyncObjs, SysUtils;

type
  //基类
  TObjBase = class(TPersistent)
  private
    FCS: TCriticalSection;
    procedure Lock;
    procedure Unlock;
  public
    procedure Clear; virtual; abstract;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  //员工
  TEmployeeClass= class of TEmployeeItem;

  TEmployeeItem= class(TCollectionItem)
  private
    fName: string;
    fSex: string;
    fImg: string;
  published
    property _Name: string read fName write fName;
    property _Sex: string read fSex write fSex;
    property _Img: string read fImg write fImg;
  public
    procedure Assign(item: TEmployeeItem); reintroduce;
  end;

  TEmployeeItems= class(TOwnedCollection)
  private
    function getItem(index: integer): TEmployeeItem;
    procedure setItem(index: Integer; const item: TEmployeeItem);
  public
    property Items[index: integer]: TEmployeeItem read getItem write setItem; default;
    function Add: TEmployeeItem;
    procedure Delete(index: integer);
    function Owner: TPersistent;
    destructor Destroy; override;
  end;

  TEmployees= class(TObjBase)
  private
    FEmployeeItems: TEmployeeItems;
    function getCount: Integer;
  protected
    function getEmployeeItemClass: TEmployeeClass;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Clear; override;

    property Count: Integer read getCount;
    property Items: TEmployeeItems read FEmployeeItems;
    function LoadFromList(sList: TStringList; var sErr: string): Boolean;
  end;

implementation

{ TObjBase }

constructor TObjBase.Create;
begin
  FCS := TCriticalSection.Create;
end;

destructor TObjBase.Destroy;
begin
  FreeAndNil(FCS);
  inherited;
end;

procedure TObjBase.Lock;
begin
  FCS.Enter;
end;

procedure TObjBase.Unlock;
begin
  FCS.Leave;
end;

{ TEmployeeItem }

procedure TEmployeeItem.Assign(item: TEmployeeItem);
begin
  if not Assigned(item) then
    Exit;
  fName:= item._Name;
  fSex:= item._Sex;
  fImg:= item._Img;
end;

{ TEmployeeItems }

function TEmployeeItems.Add: TEmployeeItem;
begin
  Result:= inherited Add as TEmployeeItem;
end;

procedure TEmployeeItems.Delete(index: integer);
begin
  inherited Delete(index);
end;

destructor TEmployeeItems.Destroy;
begin

  inherited;
end;

function TEmployeeItems.getItem(index: integer): TEmployeeItem;
begin
  Result:= inherited getItem(index) as TEmployeeItem;
end;

function TEmployeeItems.Owner: TPersistent;
begin
  Result:= GetOwner;
end;

procedure TEmployeeItems.setItem(index: integer; const item: TEmployeeItem);
begin
  inherited setItem(index, item);
end;

{ TEmployees }

procedure TEmployees.Clear;
begin
  Lock;
  try
    FEmployeeItems.Clear;
  finally
    Unlock;
  end;
end;

constructor TEmployees.Create;
begin
  inherited;
  FEmployeeItems:= TEmployeeItems.Create(Self, getEmployeeItemClass);
end;

destructor TEmployees.Destroy;
begin
  Lock;
  try
    Clear;
    if Assigned(FEmployeeItems) then
      FreeAndNil(FEmployeeItems);
  finally
    Unlock;
  end;
  inherited;
end;

function TEmployees.getCount: Integer;
begin
  Result:= FEmployeeItems.Count;
end;

function TEmployees.getEmployeeItemClass: TEmployeeClass;
begin
  Result:= TEmployeeItem;
end;

function TEmployees.LoadFromList(sList: TStringList; var sErr: string): Boolean;
var
  I, index1, index2: Integer;
  item: TEmployeeItem;
  str, sName, sSex: string;
begin
  sErr:= '';
  Result:= false;
  Clear;
  for I := 0 to sList.Count - 1 do
  begin
    str:= sList[I];
    index1:= Pos('_', str);
    index2:= Pos('.', str);
    sName:= Copy(str, 1, index1- 1);
    sSex:= Copy(str, index1+ 1, index2- index1- 1);
    item:= FEmployeeItems.Add;
    item._Name:= sName;
    item._Sex:= sSex;
    item._Img:= str;
  end;
  Result:= True;  
end;

end.

4. uFrmMain.pas单元

unit uFrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, RzPanel, StdCtrls, RzButton, uObj, jpeg, pngimage;

const
  PageSize= 12;

type
  TFrmMain = class(TForm)
    pnl_Body: TPanel;
    Panel2: TPanel;
    pnl_01: TRzPanel;
    img_01: TImage;
    lbl_01: TLabel;
    pnl_02: TRzPanel;
    img_02: TImage;
    lbl_02: TLabel;
    pnl_03: TRzPanel;
    img_03: TImage;
    lbl_03: TLabel;
    pnl_04: TRzPanel;
    img_04: TImage;
    lbl_04: TLabel;
    pnl_05: TRzPanel;
    img_05: TImage;
    lbl_05: TLabel;
    pnl_06: TRzPanel;
    img_06: TImage;
    lbl_06: TLabel;
    pnl_09: TRzPanel;
    img_09: TImage;
    lbl_09: TLabel;
    pnl_08: TRzPanel;
    img_08: TImage;
    lbl_08: TLabel;
    pnl_07: TRzPanel;
    img_07: TImage;
    lbl_07: TLabel;
    pnl_10: TRzPanel;
    img_10: TImage;
    lbl_10: TLabel;
    pnl_11: TRzPanel;
    img_11: TImage;
    lbl_11: TLabel;
    pnl_12: TRzPanel;
    img_12: TImage;
    lbl_12: TLabel;
    isex_01: TImage;
    isex_02: TImage;
    isex_03: TImage;
    isex_04: TImage;
    isex_05: TImage;
    isex_06: TImage;
    isex_07: TImage;
    isex_08: TImage;
    isex_09: TImage;
    isex_10: TImage;
    isex_11: TImage;
    isex_12: TImage;
    Label1: TLabel;
    Label2: TLabel;
    lbl_currpage: TLabel;
    lbl_Totalpage: TLabel;
    pnl_pre: TPanel;
    pnl_nxt: TPanel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure pnl_preClick(Sender: TObject);
    procedure pnl_nxtClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FEmployees: TEmployees;

    FCurrPage: Integer;     //当前页
    FTotalPage: Integer;    //总页数
    FIsFirstPage: boolean;  //是否是首页
    FIsLastPage: boolean;   //是否是末页
  public
    { Public declarations }
    procedure SearchFiles(path: string; var sList: TStringList);
    procedure ShowData(iCurrPage: integer);
  end;

var
  FrmMain: TFrmMain;

implementation

uses Math, uVar;

{$R *.dfm}

procedure TFrmMain.Button1Click(Sender: TObject);
var
  sErr: string;
  sList: TStringList;
begin
  if DirectoryExists(TFilePath.ImgPath) then
  begin
    sList:= TStringList.Create;
    try
      sList.Clear;
      SearchFiles(TFilePath.ImgPath, sList);
      if sList.Count= 0 then
        Exit;
      sList.Sort;
      if not FEmployees.LoadFromList(sList, sErr) then
      begin
        ShowMessage('数据加载失败!');
        Exit;
      end;
      //计算总页数
      FTotalPage:= Ceil(sList.Count / PageSize);
      FCurrPage:= 1;
      ShowData(FCurrPage);
      lbl_Totalpage.Caption:= Format('%d', [FTotalPage]);
      lbl_currpage.Caption:= Format('%d', [FCurrPage]);
    finally
      FreeAndNil(sList);
    end;
  end
  else
    ShowMessage(TFilePath.ImgPath+ ' 目录不存在!');
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  FEmployees:= TEmployees.Create;
  FCurrPage:= 0;
  FIsFirstPage:= False;
  FIsLastPage:= False;
  DoubleBuffered:= True;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  if Assigned(FEmployees) then
    FreeAndNil(FEmployees);
end;

procedure TFrmMain.FormShow(Sender: TObject);
var
  fhr: THandle;
begin
  //'<' 圆滑角处理
  fhr:= CreateRoundRectRgn(0, 0, pnl_pre.Width, pnl_pre.Height, 50, 50);
  SetWindowRgn(pnl_pre.Handle, fhr, true);
  //'>' 圆滑角处理
  fhr:= CreateRoundRectRgn(0, 0, pnl_nxt.Width, pnl_nxt.Height, 50, 50);
  SetWindowRgn(pnl_nxt.Handle, fhr, true);
end;

procedure TFrmMain.pnl_nxtClick(Sender: TObject);
begin
  if not FIsLastPage then
  begin
    Inc(FCurrPage);
    ShowData(FCurrPage);
  end;
end;

procedure TFrmMain.pnl_preClick(Sender: TObject);
begin
  if not FIsFirstPage then
  begin
    Dec(FCurrPage);
    ShowData(FCurrPage);
  end;
end;

procedure TFrmMain.SearchFiles(path: string; var sList: TStringList);
var
  SearchRec: TSearchRec;
  iFound: Integer;
begin
  iFound:= FindFirst(path+ '*.jpg', faArchive, SearchRec);
  while (iFound= 0) do
  begin
    if (SearchRec.Name<> '') and (SearchRec.Name<> '..') and (SearchRec.Attr<> faDirectory) then
    begin
      sList.Add(SearchRec.Name);
    end;
    iFound:= FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

procedure TFrmMain.ShowData(iCurrPage: integer);
var
  I, iBegin, iEnd : Integer;
  item: TEmployeeItem;
  procedure SetVisible(index: Integer; bShow: Boolean);
  var
    m: Integer;
    sCpName, sName: string;
  begin
    //12个模板都在pnl_Body里 就循环它就可以了
    for m := 0 to pnl_Body.ControlCount- 1 do
    begin
      sCpName:= pnl_Body.Controls[m].Name;
      if pnl_Body.Controls[m] is TRzPanel then
      begin
        sName:= Format('pnl_%.2d', [index]);
        if sCpName= sName then
          TRzPanel(pnl_Body.Controls[m]).Visible:= bShow;
      end;
    end;
  end;
  procedure SetShow(index: integer; item: TEmployeeItem);
  var
    m: Integer;
    png: TPngImage;
    fileName: string;
    sCpName, sName1, sName2: string;
  begin
    for m := 0 to Self.ComponentCount- 1 do
    begin
      sCpName:= Self.Components[m].Name;
      if Self.Components[m] is TImage then
      begin
        sName1:= Format('img_%.2d', [index]);
        sName2:= Format('isex_%.2d', [index]);
        if (sCpName<> sName1) and (sCpName<> sName2) then
          Continue;
        if (sCpName= sName1) then
        begin
          fileName:= TFilePath.ImgPath+ item._Img;
          if FileExists(fileName) then
            TImage(Self.Components[m]).Picture.LoadFromFile(fileName)
          else
            TImage(Self.Components[m]).Picture.Assign(nil);
        end;
        if (sCpName= sName2) then
        begin
          fileName:= TFilePath.PngPath+ item._Sex+ '.png';
          if FileExists(fileName) then
          begin
            png:= TPngImage.Create;
            try
              png.LoadFromFile(fileName);
              TImage(Self.Components[m]).Picture.Bitmap.Assign(png);
            finally
              FreeAndNil(png);
            end;
          end
          else
            TImage(Self.Components[m]).Picture.Bitmap.Assign(nil);
        end;
      end
      else if Self.Components[m] is TLabel then
      begin
        sName1:= Format('lbl_%.2d', [index]);
        if (sCpName<> sName1) then
          Continue;
        if (sCpName= sName1) then
          TLabel(Self.Components[m]).Caption:= item._Name;
      end;
    end;
  end;
begin
  if (iCurrPage< 1) or (iCurrPage> FTotalPage) then
    Exit;
  FIsFirstPage:= (iCurrPage= 1);
  FIsLastPage:= (iCurrPage= FTotalPage);
  if (FIsFirstPage) and (FIsLastPage) then            //首页 末页
  begin
    pnl_pre.Enabled:= False;
    pnl_nxt.Enabled:= False;
  end
  else if (FIsFirstPage) and (not FIsLastPage) then   //首页 非末页
  begin
    pnl_pre.Enabled:= False;
    pnl_nxt.Enabled:= true;
  end
  else if (not FIsFirstPage) and (FIsLastPage) then   //非首页 末页
  begin
    pnl_pre.Enabled:= true;
    pnl_nxt.Enabled:= false;
  end
  else                                                //非首页 非末页
  begin
    pnl_pre.Enabled:= true;
    pnl_nxt.Enabled:= true;
  end;
  //当前页的数据  在list中的索引位置
  iBegin:= PageSize* (iCurrPage- 1);
  iEnd:= PageSize* iCurrPage- 1;
  if iEnd> FEmployees.Count- 1 then
    iEnd:= FEmployees.Count- 1;
  //12个模板 先根据iBegin和iEnd来确定模板的是否显示
  for I := 0 to PageSize- 1 do
  begin
    if (I+ iBegin)<= iEnd then
      SetVisible(I+ 1, True)
    else
      SetVisible(I+ 1, False);
  end;
  //根据iBegin和iEnd 将数据显示到对应的控件上
  for I := iBegin to iEnd do
  begin
    item:= FEmployees.Items.Items[I];
    if not Assigned(item) then
      Continue;
    SetShow((I mod PageSize)+ 1, item);
  end;
  lbl_currpage.Caption:= Format('%d', [iCurrPage]);
end;

end.

5. 工程文件

program DelphiControlsValue;

uses
  Forms,
  uFrmMain in 'uFrmMain.pas' {FrmMain},
  uVar in 'uVar.pas',
  uObj in 'uObj.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFrmMain, FrmMain);
  Application.Run;
end.

6. 人员数据从imgs目录下获取的(图片格式"姓名_性别.jpg" 0男1女), png目录下带有性别图片.