Delphi通过TListView 动态加载图片,以阵列方式呈现

5、{*===========================================================================
  报告界面选择体位图
  @author  wuzguo
  @version 2014/04/25 NJ70C
  @todo
  @comment 报告编辑主窗体
=============================================================================}
unit ESSelectPosImageFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, DB, Controls, Forms, jpeg,
  ExtCtrls, ComCtrls, CommCtrl, ShellAPI, ImgList, Dialogs, StdCtrls, PacsGateway;

type
  ParamQuery = record
    IsDeleted: Boolean;
    FastSearchCode: string;
    BodyPicItemText: string;
    BodyPicItemID: string;
    BodyPicItemIdentify: string;
    BodyPicGroup: string;
    DisplayOrder: Integer;
  end;

type
  PListData = ^TListData;

  TListData = record
    StrName: string;
    PicIndex: integer;
    ItemID: string;
    ItemIdentify: string;
    ItemImage: TImage;
  end;

  TBodyPicItem = class
    BIFSelected: Boolean;
    BIsDeleted: Boolean;
    FFastSearchCode: string;
    FBodyPicName: string;
    FBodyPicItemID: string;
    FBodyPicItemIdentify: string;
    FBodyPicGroup: string;
    FDisplayOrder: Integer;
    ImBodyItemPicture: TImage;

  private
    {----------------------}

  public
    constructor Create;
    destructor Destroy;

    property IFSelected: Boolean read BIFSelected write BIFSelected;
    property IsDeleted: Boolean read BIsDeleted write BIsDeleted;

    property FastSearchCode: string read FFastSearchCode write FFastSearchCode;
    property BodyPicName: string read FBodyPicName write FBodyPicName;
    property BodyPicItemID: string read FBodyPicItemID write FBodyPicItemID;
    property BodyPicItemIdentify: string read FBodyPicItemIdentify write FBodyPicItemIdentify;
    property BodyPicGroup: string read FBodyPicGroup write FBodyPicGroup;
    property DisplayOrder: Integer read FDisplayOrder write FDisplayOrder;
  end;

const
  DISTANCE_TOP = 8;
  DISTANCE_RIGHTANDLEFT = 70;
  DISTANCE_ICONTOP = 70;

type
  IntArrBodyPic = array of TBodyPicItem;


  TFrmSelectPosImage = class(TForm)
    pnlTop: TPanel;
    pnlButton: TPanel;
    cbbItemText: TComboBox;
    lblInspectionType: TLabel;
    grpSelectList: TGroupBox;
    ListViewImage: TListView;
    ImageListPic: TImageList;
    ImageListBack: TImageList;
    img1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure cbbItemTextChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ListViewImageAdvancedCustomDrawItem(Sender: TCustomListView; Item:
      TListItem; State: TCustomDrawState; Stage: TCustomDrawStage; var
      DefaultDraw: Boolean);
    procedure ListViewImageDblClick(Sender: TObject);
    procedure ListViewImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
      Integer);
  private
    { Private declarations }
    FBodyPosPictureName, FBodyPosPictureItemID, FBodyPosPictureItemIdentify, FDefaultBodyPosItem: string;
    FImageQuery: LCacheQuery;
    function GetBodyPositionPicture(ltQuery: LCacheQuery; Param: ParamQuery): IntArrBodyPic;
    procedure AddDBToComboBox(ComBox: TComboBox; ltQuery: LCacheQuery; Param: ParamQuery);
    procedure ShowImageToListView(latPic: IntArrBodyPic; var ltview: TListView);
    procedure UpdateListViewImageShow(Param: ParamQuery);
    function ResizeImage(var SrcImage: TImage; Scale: Integer = 1): TImage;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
    property BodyPosPictureName: string read FBodyPosPictureName write FBodyPosPictureName;
    property BodyPosPictureItemID: string read FBodyPosPictureItemID write FBodyPosPictureItemID;
    property BodyPosPictureItemIdentify: string read FBodyPosPictureItemIdentify write FBodyPosPictureItemIdentify;
    property DefaultBodyPosItem: string read FDefaultBodyPosItem write FDefaultBodyPosItem;
  end;

var
  FrmSelectPosImage: TFrmSelectPosImage;
  BodyPicItem: TBodyPicItem;
  arrBodyPic: IntArrBodyPic;
  PicImage: TImage;
  ListShortCut: TList;
//  ParamBodyPic : ParamQuery;

implementation

uses uReportEditorHelper, uDBCommandID, uMsgBox, uGlobal, uReportConst;

{$R *.dfm}

{ TBodyPicItem }

constructor TBodyPicItem.Create;
begin
  inherited;
  BIFSelected := False;
  BIsDeleted := False;
  FFastSearchCode := '';
  FBodyPicName := '';
  FBodyPicItemID := '';
  FBodyPicItemIdentify := '';
  FBodyPicGroup := '';
  FDisplayOrder := 0;
end;

destructor TBodyPicItem.Destroy;
begin
  inherited;
end;

{TFrmSelectPosImage}

constructor TFrmSelectPosImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImageQuery := LCacheQuery.Create(ReportEditorHelper.GetOfflineStatus);
end;

procedure TFrmSelectPosImage.FormCreate(Sender: TObject);
var
  ImgList: TImageList;
begin
  FBodyPosPictureName := '';
  FBodyPosPictureItemID := '';
  FBodyPosPictureItemIdentify := '';

  ListViewImage.DoubleBuffered := true; //启用双缓存,防止闪屏
  ListViewImage.Tag := -1; //记住上次mouse所在item的id,这个tag一般不用正好用来做全局变量
  ListShortCut := TList.Create;

  // 这里设置ListView的LargeImages, 用ListView将其Item放大
  ImgList := TImageList.Create(nil);
  ImgList.Width := 95;
  ImgList.Height := 95;
  ListViewImage.LargeImages := ImgList;
  SendMessage(ListViewImage.Handle, LVM_SETICONSPACING, 0, MakeLong(100, 100)); //设定Icon的间距
end;

destructor TFrmSelectPosImage.Destroy;
var
  I: Integer;
begin
  inherited Destroy;

  if Assigned(FImageQuery) then
    FreeAndNil(FImageQuery);

  if Assigned(BodyPicItem) then
    FreeAndNil(BodyPicItem);

  for I := 0 to Length(arrBodyPic) - 1 do // 循环释放,先释放属性,再释放实例
  begin
    if Assigned(arrBodyPic[i].ImBodyItemPicture) then
      FreeAndNil(arrBodyPic[i].ImBodyItemPicture);

    if Assigned(arrBodyPic[i]) then
      FreeAndNil(arrBodyPic[i]);
  end;

  if Assigned(ListShortCut) then
    FreeAndNil(ListShortCut);

  if Assigned(PicImage) then
    FreeAndNil(PicImage);

end;

function TFrmSelectPosImage.GetBodyPositionPicture(ltQuery: LCacheQuery; Param: ParamQuery): IntArrBodyPic;
var
  II: Integer;
  MemoryStream: TMemoryStream;
  Image: TImage;
  PicImagePath: string;
  DBModifyDateTime: TDateTime;
  BlIfLocalImage: Boolean;
  FParam: LPDBParameter;
  ListData, xxx: Plistdata;
begin
  LogDebug('TFrmSelectPosImage.GetBodyPositionPicture', 'Begin');

  if not Assigned(ltQuery) then Exit;

  try
    ltQuery.Clear;

    with Param, ltQuery do
    begin
      if Trim(BodyPicItemText) <> '' then
        ParamByName('InspectionItemText').AsString := BodyPicItemText;
      if Trim(BodyPicItemID) <> '' then
        ParamByName('InspectionItemID').AsString := BodyPicItemID;
      if Trim(BodyPicItemIdentify) <> '' then
        ParamByName('InspectionItemIdentify').AsString := BodyPicItemIdentify;
      if Trim(BodyPicGroup) <> '' then
        ParamByName('InspectionItemGroup').AsString := BodyPicGroup;
    end;

    if ltQuery.Execute(PDB_LOAD_ES_ALLINSPECTIOITEM) then // 取数据库中的数据
    begin
      if ltQuery.RecordCount > 0 then
      begin
        SetLength(arrBodyPic, ltQuery.RecordCount);
        MemoryStream := TMemoryStream.Create;

        try
          ltQuery.First;
          for II := 0 to ltQuery.RecordCount - 1 do
          begin
            BodyPicItem := TBodyPicItem.Create;

            PicImage := TImage.Create(nil);
          //  PicImage.Width := 200;
          //  PicImage.Height := 200;

            BlIfLocalImage := False;

            New(ListData);

            with ltQuery, BodyPicItem do
            begin
              BIFSelected := False;
              BIsDeleted := FieldByName('IsDeleted').AsBoolean;
              FFastSearchCode := FieldByName('FastSearchCode').AsString;
              FBodyPicName := FieldByName('InspectionItemText').AsString;
              FBodyPicItemID := FieldByName('InspectionItemID').AsString;
              FBodyPicItemIdentify := FieldByName('InspectionItemIdentify').AsString;
              FBodyPicGroup := FieldByName('InspectionItemGroup').AsString; // 数据库暂时还没有这个字段 zhiguo.wu 2014-04-25
              FDisplayOrder := FieldByName('DisplayOrder').AsInteger;
              DBModifyDateTime := FieldByName('ModifiedDateTime').AsDateTime;
              PicImagePath := IncludeTrailingPathDelimiter(ExtractFilePath((ParamStr(0)))) + Rpt_POSIMAGESPATH + FBodyPicName + '.BMP';

              if not FileExists(PicImagePath) then
              begin
                if GetFileDateTime(PicImagePath) < DBModifyDateTime then
                begin
                  MemoryStream.Clear;
                  FieldByName('BodyPositionPicture').SaveToStream(MemoryStream); // 加载数据库中的图
                  MemoryStream.Position := 0;
                 // TBlobField(PicImage).LoadFromStream(MemoryStream);
                  PicImage.Picture.Bitmap.LoadFromStream(MemoryStream);
                  BlIfLocalImage := True;
                end;
              end;

              if not BlIfLocalImage then
              begin
                PicImage.Picture.LoadFromFile(PicImagePath); // 加载本地体位图
                 ListData.ItemImage.Picture.LoadFromFile(PicImagePath);
              end;

              ListData.StrName := FBodyPicName;
              ListData.ItemID :=  FBodyPicItemID;

              ListShortCut.Add(ListData);

              ImBodyItemPicture := ResizeImage(PicImage, 2);

              ImBodyItemPicture.Picture.SaveToFile('c:/ImBodyItemPicture.Picture.bmp');
              arrBodyPic[II] := BodyPicItem;
            end;

            ltQuery.Next;
          end;
        finally
          FreeAndNil(MemoryStream);
        end;

      end;
    end;

    Result := arrBodyPic;

  except
    on E: Exception do
    begin
      LogError('TFrmSelectPosImage.GetBodyPositionPicture', e.Message);
    end;
  end;

  LogDebug('TFrmSelectPosImage.GetBodyPositionPicture', 'End');
end;

procedure TFrmSelectPosImage.AddDBToComboBox(ComBox: TComboBox; ltQuery: LCacheQuery; Param: ParamQuery);
var
  ItemData: TItemData;
  FParam: LPDBParameter;
begin
  if not Assigned(ltQuery) then Exit;

  ltQuery.Clear;
  ComBox.Items.Clear;

  with Param, ltQuery do
  begin
    if Trim(BodyPicItemText) <> '' then
      ParamByName('InspectionItemText').AsString := BodyPicItemText;
    if Trim(BodyPicItemID) <> '' then
      ParamByName('InspectionItemID').AsString := BodyPicItemID;
    if Trim(BodyPicItemIdentify) <> '' then
      ParamByName('InspectionItemIdentify').AsString := BodyPicItemIdentify;
    if Trim(BodyPicGroup) <> '' then
      ParamByName('InspectionItemGroup').AsString := BodyPicGroup;

  end;

  if ltQuery.Execute(PDB_LOAD_ES_ALLINSPECTIOITEM) then
  begin
    ltQuery.First;
    while not ltQuery.IsEof do
    begin
      ItemData := TItemData.Create;
      ItemData.ID := ltQuery.FieldByName('InspectionItemIdentify').AsInteger;
      ItemData.ItemText := ltQuery.FieldByName('InspectionItemText').AsString;
      ItemData.FastSearchCode := ltQuery.FieldByName('FastSearchCode').AsString;
      ComBox.Items.AddObject(ItemData.ItemText, ItemData);
      ltQuery.Next;
    end;
  end;
end;

procedure TFrmSelectPosImage.cbbItemTextChange(Sender: TObject);
var
  cbbParam: ParamQuery;
begin
  cbbParam.BodyPicGroup := cbbItemText.Text;
  UpdateListViewImageShow(cbbParam);
  // 刷新图片界面
end;

procedure TFrmSelectPosImage.FormResize(Sender: TObject);
begin
// Self.Repaint;
end;


procedure TFrmSelectPosImage.ShowImageToListView(latPic: IntArrBodyPic; var ltview: TListView);
var
  II: Integer;
  Btp: TBitmap;
  ListData, xxx: Plistdata;
begin
  ImageListPic.Clear;
  ltview.Items.Clear;
// ListShortCut.Clear;
  try
    Btp := TBitmap.Create;
    for II := 0 to Length(latPic) - 1 do
    begin
      Btp := latPic[II].ImBodyItemPicture.Picture.Bitmap;
      Btp.SaveToFile('c:/Btp.bmp');
      ImageListPic.Add(Btp, Btp);
      New(ListData);
      ListData.StrName := latPic[II].FBodyPicName;
      ListData.PicIndex := latPic[II].FDisplayOrder;
      ListData.ItemID := latPic[II].FBodyPicItemID;
      ListData.ItemIdentify := latPic[II].FBodyPicItemIdentify;
      ListData.ItemImage := latPic[II].ImBodyItemPicture;
      ListData.ItemImage.Picture.SaveToFile('c:/ListData.ItemImage.Picture.bmp');
      latPic[II].ImBodyItemPicture.Picture.SaveToFile('c:/latPicII.ImBodyItemPicture.Picture.bmp');
     // ListShortCut.Add(ListData);

//      xxx :=  ListShortCut.Items[II];
//      xxx.ItemImage.Picture.SaveToFile('C:/xxx.ItemImage.'+inttostr(II)+'.bmp');

    end;

    for II := 0 to ListShortCut.Count - 1 do //加空item
      ltview.Items.add;

  finally
    FreeAndNil(Btp);
  end;

end;

procedure TFrmSelectPosImage.FormShow(Sender: TObject);
var
  cbbParam: ParamQuery;
begin
  if Trim(FrmSelectPosImage.DefaultBodyPosItem) <> '' then
    cbbParam.BodyPicGroup := Trim(FrmSelectPosImage.DefaultBodyPosItem);

  AddDBToComboBox(cbbItemText, FImageQuery, cbbParam);

//  ShowMessage(FrmSelectPosImage.DefaultBodyPosItem);

  cbbItemText.ItemIndex := cbbItemText.Items.IndexOf(Trim(FrmSelectPosImage.DefaultBodyPosItem));

//  cbbItemText.ItemIndex := 0;

  cbbParam.BodyPicGroup := Trim(cbbItemText.Text);

//  ShowMessage(Trim(cbbItemText.Text));

  UpdateListViewImageShow(cbbParam);
end;

procedure TFrmSelectPosImage.UpdateListViewImageShow(Param: ParamQuery);
var
  Hdle: Thandle;
  cbbParam: ParamQuery;
begin
  LogDebug('TFrmSelectPosImage.UpdateListViewImageShow', 'Begin');
  try
    Hdle := CreateRoundRectRgn(0, 0, Width + 1, Height + 1, 5, 5); //定义圆角矩形(winAPI函数)
    SetWindowRgn(Handle, Hdle, True); //设置圆角窗口

    GetBodyPositionPicture(FImageQuery, Param);

    ShowImageToListView(arrBodyPic, ListViewImage);
  except
    on E: Exception do
    begin
      LogError('TFrmSelectPosImage.UpdateListViewImageShow', e.Message);
    end;
  end;

  LogDebug('TFrmSelectPosImage.UpdateListViewImageShow', 'End');
end;

procedure TFrmSelectPosImage.ListViewImageAdvancedCustomDrawItem(Sender:
  TCustomListView; Item: TListItem; State: TCustomDrawState; Stage:
  TCustomDrawStage; var DefaultDraw: Boolean);
var
  Rct: TRect; //文字覆盖的范围
  Imglistviewbk: TBitmap; //背景
  SoftIcon: TBitmap; //图标
  ListData: Plistdata;
begin
  Rct := Item.DisplayRect(drBounds);
  ListData := listshortcut.Items[Item.index];
  ListData := listshortcut.Items[0];
  ListData.ItemImage.Picture.LoadFromFile('c:/ImBodyItemPicture.Picture.bmp');

  ListData.ItemImage.Picture.SaveToFile('c:/ListData.ItemImage.Picture.bmp');
  ListData.ItemImage.Picture.Bitmap.SaveToFile('c:/ListData.ItemImage.Bitmap.Picture.bmp');

  ListData.ItemImage.Picture.SaveToFile('c:/ListData.ItemImage.Picture1.bmp');

  ShowMessage(ListData.StrName);
  ShowMessage(ListData.ItemIdentify);


  try
    with ListViewImage.Canvas do
    begin
      if cdsSelected in State then
      begin
        try
          Imglistviewbk := TBitmap.Create;
          Imglistviewbk.Width := ImageListBack.Width + 15; // 70 + 15
          Imglistviewbk.Height := ImageListBack.Height + 15;

          ImageListBack.Draw(Imglistviewbk.Canvas, 0, 0, 0, True);

        //  Imglistviewbk.Canvas.Draw(0, 0, ListData.ItemImage.Picture.Bitmap);

          StretchDraw(Rct, Imglistviewbk); //画背景图
        finally
          Imglistviewbk.Free;
        end;
      end;

      //画图标
      SoftIcon := TBitmap.Create;
      try
//       ShowMessage(IntToStr( ListData.ItemImage.Width));
//       ShowMessage(IntToStr( ListData.ItemImage.Picture.Width));
//       ShowMessage(IntToStr( ListData.ItemImage.Picture.Bitmap.Width));

        ListData.ItemImage.Picture.SaveToFile('c:/ItemImage.Picture.bmp');
        ListData.ItemImage.Picture.Bitmap.SaveToFile('c:/Picture.Bitmap.bmp');
       
        SoftIcon.Width := 52;
        SoftIcon.Height := 52;
//
//        ImageListPic.Draw(SoftIcon.Canvas, 0, 0, Item.index, true); // 加载图片
//
//        SoftIcon := ListData.ItemImage.Picture.Bitmap;
        Draw(Rct.Left + (Rct.Right - Rct.left - DISTANCE_RIGHTANDLEFT) div 2, Rct.top + DISTANCE_TOP, ListData.ItemImage.Picture.Bitmap);

      finally
        SoftIcon.Free;
      end;

      //  画软件名称
      Rct.top := Rct.top + DISTANCE_ICONTOP;
      Rct.Bottom := Rct.Bottom - 5;
      Rct.left := Rct.left + 3;
      Rct.right := Rct.right - 3;
      SetBkMode(Handle, TRANSPARENT); //设定文字为透明
      DrawText(Handle, PChar(ListData.StrName), Length(ListData.StrName) + 2, Rct, DT_WORDBREAK or DT_CENTER);

    end;
    with Sender.Canvas do
    begin
      if Assigned(Font.OnChange) then
        Font.OnChange(Font);
    end;

  except
    on E: Exception do
    begin
      LogError('TFrmSelectPosImage.ListViewImageAdvancedCustomDrawItem', e.Message);
    end;
  end;

end;

procedure TFrmSelectPosImage.ListViewImageDblClick(Sender: TObject);
var
  ItemIdentify: string;
  ListData: Plistdata;
  II: Integer;
begin
  try
    if ListViewImage.ItemIndex < 0 then exit;
    ListData := ListShortCut.Items[ListViewImage.ItemIndex];

    ItemIdentify := ListData.ItemIdentify;

    for II := 0 to Length(arrBodyPic) - 1 do
    begin
      if SameText(ItemIdentify, arrBodyPic[II].FBodyPicItemIdentify) then
      begin
        arrBodyPic[II].BIFSelected := True;
        Break;
      end;
    end;

    FBodyPosPictureName := ListData.StrName; // 属性赋值
    FBodyPosPictureItemID := ListData.ItemID;
    FBodyPosPictureItemIdentify := ListData.ItemIdentify;

    ModalResult := mrOk; // 关闭界面
  except
    on e: Exception do
    begin
      LogError('TFrmSelectPosImage.ListViewImageDblClick', e.Message);
    end;
  end;
end;

procedure TFrmSelectPosImage.ListViewImageMouseMove(Sender: TObject; Shift:
  TShiftState; X, Y: Integer);
var
  Pi: TPoint;
  Litem: TListItem;
  ListIndex: Integer;
  Rct: TRect; //R为文字覆盖的范围
  ImgListViewbk: TBitmap; //RFill为文字填充的范围
  SoftIcon: TBitmap;
  ListData: Plistdata;
begin
  Pi.X := x;
  Pi.Y := y;
  Litem := ListViewImage.GetItemAt(Pi.x, Pi.y);
  ListIndex := (Sender as TListView).Items.IndexOf(Litem);
  if ListIndex = -1 then Exit;
  if ListViewImage.Items.Count = 0 then exit;

  if ListViewImage.Tag = -1 then //第一次进入一个item 画当前item
  begin
    ListViewImage.Tag := ListIndex;

    Rct := ListViewImage.Items[ListIndex].DisplayRect(drBounds);
    ListData := listshortcut.Items[ListIndex];

    with ListViewImage.Canvas do
    begin

      try
        Imglistviewbk := TBitmap.Create;
        Imglistviewbk.Width := ImageListBack.Width + 15;
        Imglistviewbk.Height := ImageListBack.Height + 15;

        ImageListBack.Draw(Imglistviewbk.Canvas, 0, 0, 0, True);

        //  Imglistviewbk.Canvas.Draw(0, 0, ListData.ItemImage.Picture.Bitmap);

        StretchDraw(Rct, Imglistviewbk); //画背景图
      finally
        Imglistviewbk.Free;
      end;

    //画图标
      SoftIcon := TBitmap.Create;
      try
        SoftIcon.Width := ListData.ItemImage.Picture.Bitmap.Width;
        SoftIcon.Height := ListData.ItemImage.Picture.Bitmap.Height;
//
//        ImageListPic.Draw(SoftIcon.Canvas, 0, 0, Item.index, true); // 加载图片
//
//        SoftIcon := ListData.ItemImage.Picture.Bitmap;
        Draw(Rct.Left + (Rct.Right - Rct.left - DISTANCE_RIGHTANDLEFT) div 2, Rct.top + DISTANCE_TOP, ListData.ItemImage.Picture.Bitmap);

      finally
        SoftIcon.Free;
      end;

      //  画软件名称
      Rct.top := Rct.top + DISTANCE_ICONTOP;
      Rct.Bottom := Rct.Bottom - 5;
      Rct.left := Rct.left + 3;
      Rct.right := Rct.right - 3;
      SetBkMode(Handle, TRANSPARENT); //设定文字为透明
      DrawText(Handle, PChar(ListData.StrName), Length(ListData.StrName) + 2, Rct, DT_WORDBREAK or DT_CENTER);

    end;
    with ListViewImage.Canvas do
      if Assigned(Font.OnChange) then Font.OnChange(Font);

  end
  else if (ListViewImage.Tag <> -1) and (ListViewImage.Tag <> ListIndex) then //如果是已有上次mouse所在位置id,同时本次mouse所在id与上次不同,则先画本次mouse所在id,同时将上次id的item画成默认的
  begin
     //画当前item
    Rct := ListViewImage.Items[ListIndex].DisplayRect(drBounds);
    ListData := listshortcut.Items[ListIndex];

    with ListViewImage.Canvas do
    begin
      try
        Imglistviewbk := TBitmap.Create;
        Imglistviewbk.Width := ImageListBack.Width + 15;
        Imglistviewbk.Height := ImageListBack.Height + 15;

        ImageListBack.Draw(Imglistviewbk.Canvas, 0, 0, 0, True);

        Imglistviewbk.Canvas.Draw(0, 0, ListData.ItemImage.Picture.Bitmap);
        StretchDraw(Rct, Imglistviewbk); //画背景图
      finally
        Imglistviewbk.Free;
      end;


    //画图标
      try
        SoftIcon := TBitmap.Create;
        SoftIcon.Width := ListData.ItemImage.Picture.Bitmap.Width;
        SoftIcon.Height := ListData.ItemImage.Picture.Bitmap.Height;
//
//      ImageListPic.Draw(SoftIcon.Canvas, 0, 0, ListIndex, true);
//      Draw(Rct.Left + (Rct.Right - Rct.left - 32) div 2, Rct.top + 5, SoftIcon);
//
        Draw(Rct.Left + (Rct.Right - Rct.left - DISTANCE_RIGHTANDLEFT) div 2, Rct.top + DISTANCE_TOP, ListData.ItemImage.Picture.Bitmap);
      finally
        SoftIcon.Free;
      end;

      //  画软件名称
      Rct.top := Rct.top + DISTANCE_ICONTOP;
      Rct.Bottom := Rct.Bottom - 5;
      Rct.left := Rct.left + 3;
      Rct.right := Rct.right - 3;
      SetBkMode(Handle, TRANSPARENT); //设定文字为透明
      DrawText(Handle, PChar(ListData.StrName), Length(ListData.StrName) + 2, Rct, DT_WORDBREAK or DT_CENTER);
    end;
    //恢复上一个的颜色
    Rct := ListViewImage.Items[ListViewImage.tag].DisplayRect(drBounds);
    ListData := listshortcut.Items[ListViewImage.tag];

    with ListViewImage.Canvas do
    begin
      try
        Brush.Color := clWhite;
        FillRect(Rct); //填充颜色
      //画图标
        SoftIcon := TBitmap.Create;
//      SoftIcon.Width := 32;
//      SoftIcon.Height := 32;

//      ImageListPic.Draw(SoftIcon.Canvas, 0, 0, ListViewImage.tag, true);
//      Draw(Rct.Left + (Rct.Right - Rct.left - 32) div 2, Rct.top + 5, SoftIcon);
        Draw(Rct.Left + (Rct.Right - Rct.left - DISTANCE_RIGHTANDLEFT) div 2, Rct.top + DISTANCE_TOP, ListData.ItemImage.Picture.Bitmap);
      finally
        SoftIcon.Free;
      end;

      //  画软件名称
      Rct.top := Rct.top + DISTANCE_ICONTOP;
      Rct.Bottom := Rct.Bottom - 5;
      Rct.left := Rct.left + 3;
      Rct.right := Rct.right - 3;
      SetBkMode(Handle, TRANSPARENT); //设定文字为透明
      DrawText(Handle, PChar(ListData.StrName), Length(ListData.StrName) + 2, Rct, DT_WORDBREAK or DT_CENTER);

    end;
    with ListViewImage.Canvas do
    begin
      if Assigned(Font.OnChange) then
        Font.OnChange(Font);
    end;
    ListViewImage.Tag := listindex;
  end;

end;

function TFrmSelectPosImage.ResizeImage(var SrcImage: TImage; Scale: Integer = 1): TImage; // 缩放图片
var
  DstImage: TBitMap;
  Rect: TRect;
  DstWidth, DstHeight: Integer;
begin
  with SrcImage do
  begin
    DstWidth := SrcImage.Width div Scale;
    DstHeight := SrcImage.Height div Scale;
  end;

  try
    DstImage := TBitMap.Create;

    with DstImage do
    begin
      Width := DstWidth;
      Height := DstHeight;
      PixelFormat := pf32bit;
      Rect.TopLeft := Point(0, 0);
      Rect.BottomRight := Point(DstWidth, DstHeight);
      Canvas.Rectangle(0, 0, Width, Height);
      Canvas.StretchDraw(Rect, TGraphic(SrcImage.Picture.Bitmap));
    end;

    SrcImage.Picture.Bitmap.Assign(DstImage);
    SrcImage.Update;

    Result := SrcImage;
  finally
    FreeAndNil(DstImage);
  end;
end;

end.

你可能感兴趣的:(Delphi通过TListView 动态加载图片,以阵列方式呈现)