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.