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

最新推荐文章于 2024-04-24 15:42:15 发布

chuliu1184

最新推荐文章于 2024-04-24 15:42:15 发布

阅读量859

点赞数

文章标签：移动开发数据库

原文链接：https://my.oschina.net/yyangwu/blog/308001

版权

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.

转载于:https://my.oschina.net/yyangwu/blog/308001

chuliu1184

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
Delphi通过TListView 动态加载图片，以阵列方式呈现

5、{*=========================================================================== 报告界面选择体位图 @author wuzguo @version 2014/04/25 NJ70C @todo @co...
复制链接

扫一扫