图片显示处理 delphi7调用测试
{*------------------------------------------------------------------------
Filename: UntImage.pas
Author: 张述勇
Version: 1.0
Date: 2004.6.2
Description: 图片操作处理类
功能：对于建立批量图片；
建立图片、建立图片标注、图片定位。
Others:
Revision history:
//------------------------------------------------------------------------- }
unit UntImage;
interface
uses classes,Windows, SysUtils,Dialogs,Forms,Controls,Graphics,StdCtrls,ExtCtrls,jpeg,types,DBClient;
const
IMG_WIDTH = 100; //图片宽度
IMG_HEIGHT = 100; //图片高度
IMG_SPACE = 50; //图片间距
DESC_HEIGHT = 45;
IMG_DESC_SPACE = 5;//图片与描述之间的间距
type
{文件信息类 记录图形文件的各种信息，如名字，路径，类型等}
TImgInfo = class(Tobject)
ImgPath : string; //文件路径 和 文件名
ImgName : string; //文件名称 (指文件标识)
ImgType : string; //文件类型
ImgAuto : Boolean; //是否自动缩放（图片控件）
ImgStrect: Boolean; //是否自动缩放（图片）
Remark : string; // 备注
end;
type
TImageOperat = Class(TObject) {图片操作类}
private
Big_Img : TImage;
Mem_Label:Tmemo;
ImgInfoList : Tlist; {图片信息容器}
ImgArr : Array of TImage; {图片信息对像数组}
DescArr :Array of TMemo; {图片描述对象数组，对应每一张图片一个}
{把取得图像文件的信息，压人ImgInfoList容器中}
procedure ProAddImgInfo(ParamImgInfo : TImgInfo);
{根据TLIST中的数据建立图形,
ParamParent参数为图形的父组件}
function FunCreateImg(ParamCon:TWinControl):Boolean;
{根据信息建立图片的标注 例如：文件名一样；
ParamParent参数为图形的父组件,ParamData 参数为图形的数据}
procedure ProCreateLabel(ParamCon:TWinControl;ParamData:TClientDataSet);
{处理建立的图片的位置
ParamParent 图形的父组件；ParamPosition 第一行图片的TOP定位}
procedure ProSetImgPosition(ParamCon:TWinControl;ParamPosition:Integer);
{对字符串进行拆分 加入回车符
ParamStr参数为整个字符；ParamLen 参数为每行的字符个数}
function FunWordWarp(ParamStr:String;ParamLen:Integer):String;
//
procedure FunImgClick(Sender: Tobject);
// procedure FunImgClick(Sender:Tobject) ;
public
{构造}
constructor Create;
{析构}
destructor Destory;
{取得图像文件的路径}
function FunGetFilePath(FileName:String):String;
{调用图片显示过程
ParamParent 图形的父组件； ParamData 参数为图形的数据}
procedure ProImageShow(ParamCon:TWinControl;ParamData:TClientDataSet);
procedure SetBig_Img(var ParamImg:Timage;var ParamMem:TMemo);
Procedure FreeImg;
end;
var
Image :TImageOperat ;
Imgpath:string;
implementation
//uses uImgManager;
{ TImageOperat }
procedure TImageOperat.FunImgClick(Sender: Tobject);
var
I:integer;
Name:string;
begin
try
Name := (sender as TImage).Name ;
I := StrToInt(copy(Name,7,length(Name)-1));
Big_Img.Picture.LoadFromFile(TImgInfo(Image.ImgInfoList[I]).ImgPath);
Mem_Label.Text := TImgInfo(Image.ImgInfoList[I]).ImgName;
except
Application.MessageBox('图片打开出错，检查是否存在该图片','信息提示',MB_OK+MB_IconInformation);
end;
end;
constructor TImageOperat.Create;
begin
end;
destructor TImageOperat.Destory;
var
i : Integer;
begin
for i := 0 to length(ImgArr)-1 do
FreeAndNil(ImgArr[i]);
if Assigned(ImgInfoList) then
begin
ImgInfoList.Clear;
ImgInfoList.Free;
ImgInfoList := nil;
end;
end;
procedure TImageOperat.ProAddImgInfo(ParamImgInfo : TImgInfo);
begin
if not Assigned(ImgInfoList) then
ImgInfoList := TList.Create;
ImgInfoList.Add(ParamImgInfo);
end;
function TImageOperat.FunGetFilePath(FileName:String): String;
begin
Result := ExtractFilePath(Paramstr(0))+'Jpg\'+ FileName ;
end;
function TImageOperat.FunCreateImg(ParamCon:TWinControl): Boolean;
var
I : Integer;
begin
setLength(ImgArr,ImgInfoList.Count);
for i := 0 to ImgInfoList.Count-1 do
begin
ImgArr[I] := TImage.Create(nil);
ImgArr[I].parent := ParamCon;
ImgArr[I].AutoSize := False;
ImgArr[I].Stretch := True;
ImgArr[I].Width := IMG_WIDTH;
ImgArr[I].Height := IMG_HEIGHT;
ImgArr[I].Name := 'ImgArr'+IntTostr(I);
ImgArr[I].OnClick := FunImgClick;
if FileExists(TImgInfo(ImgInfoList[i]).ImgPath) then
ImgArr[I].Picture.LoadFromFile(TImgInfo(ImgInfoList[i]).ImgPath);
end;
end;
procedure TImageOperat.ProCreateLabel(ParamCon: TWinControl;
ParamData:TClientDataSet);
var
I : Integer;
tmpLabel:Tmemo;
begin
SetLength(DescArr,length(ImgArr));
for I := 0 to length(DescArr)-1 do
begin
DescArr[I] := Tmemo.Create(nil);
DescArr[I].Font.Name := '宋体';
DescArr[I].Font.Size := 9;
DescArr[I].WordWrap := True;
DescArr[I].BorderStyle := bsNone;
DescArr[I].BevelInner := bvNone;
DescArr[I].BevelOuter := bvNOne;
DescArr[I].Parent := ParamCon;
DescArr[I].Width := IMG_WIDTH;
DescArr[I].Height := DESC_HEIGHT;
DescArr[I].Color := cl3DLight;
DescArr[I].Text := ParamData.FieldValues['Pr_name'];
DescArr[I].Top := ImgArr[i].Top + ImgArr[i].Height + IMG_DESC_SPACE;
DescArr[I].Left := ImgArr[i].Left;
{if DescArr[I].Width > ImgArr[i].Width then
begin
DescArr[I].Width := ImgArr[i].Width;
DescArr[I].Height := ((DescArr[I].Width div ImgArr[i].Width)+1)*DESC_HEIGHT;
DescArr[I].Left := ImgArr[i].Left;
DescArr[I].Caption := FunWordWarp(ParamData.FieldValues['Pr_name'],ImgArr[i].Width);
end
else
begin
DescArr[I].Left := ImgArr[i].Left+Trunc(ImgArr[i].Width-DescArr[I].Width/2);
end; }
end;
end;
procedure TImageOperat.ProSetImgPosition(ParamCon:TWinControl;ParamPosition:Integer);
var
i,j,k : Integer; {计数器}
Row,Col: Integer; {行 列}
begin
k:= 0;
Col := ParamCon.Width div (IMG_WIDTH+IMG_SPACE);
Row := ImgInfoList.Count div Col;
if ImgInfoList.Count mod Col >0 then Row :=Row +1;
for i := 0 to Row-1 do
for j:= 0 to Col-1 do
begin
ImgArr[k].Top := ParamPosition+IMG_SPACE+(IMG_HEIGHT+IMG_SPACE)*i;
ImgArr[k].Left := (IMG_WIDTH+IMG_SPACE)*j;
k := k+1 ;
if k= ImgInfoList.Count then break;
end;
end;
procedure TImageOperat.ProImageShow(ParamCon:TWinControl;ParamData:TClientDataSet);//调用图片显示过程
var
I : Integer;
ImgInfo : TImgInfo;
begin
try
// for I := 0 to ParamData.RecordCount-1 do
if ParamData.RecordCount= 0 then Exit;
ParamData.First;
while not ParamData.Eof do
begin
ImgInfo := TImgInfo.Create;
ImgInfo.ImgPath := ParamData.FieldByName('ImageName').AsString;
ImgInfo.ImgName := ParamData.FieldByName('Pr_name').AsString;
Image.ProAddImgInfo(ImgInfo); //压入到图片容器中
ParamData.Next;
end ;
{建立图片对象}
Image.FunCreateImg(ParamCon);
{移动图片相对位置}
Image.ProSetImgPosition(ParamCon,5);
Image.ProCreateLabel(ParamCon,ParamData);
finally
// FreeAndNil(ImgInfo);
end;
end;
function TImageOperat.FunWordWarp(ParamStr: String; ParamLen: Integer):String;
var
StrLen,I : Integer;
TmpStr:String;
begin
StrLen := Length(ParamStr);
TmpStr := '';
for I := 0 to Length(ParamStr)-1 do
begin
if I = 0 then
TmpStr := Copy(ParamStr,I*ParamLen,ParamLen)
else
TmpStr := TmpStr+#13+#10+Copy(ParamStr,I*ParamLen,ParamLen);
end;
Result := TmpStr;
end;
{procedure TImageOperat.FunImgClick(Sender: Tobject);
var
I:integer;
Name:string;
begin
try
Name := (sender as TImage).Name ;
I := StrToInt(copy(Name,7,length(Name)-1));
Big_Img.Picture.LoadFromFile(TImgInfo(ImgInfoList[I]).ImgPath);
except
end;
end; }
procedure TImageOperat.SetBig_Img(var ParamImg:Timage;var ParamMem:TMemo);
begin
Big_Img := ParamImg;
Mem_Label := paramMem;
end;
//initialization
// Image :=TImageOperat.Create;
//finalization
// FreeAndNil(Image);
procedure TImageOperat.FreeImg;
var
i : integer;
begin
{对上次所有图形标识进行释放}
for i:= Length(ImgArr)-1 downto 0 do
begin
freeAndNil(ImgArr[I]);
FreeAndNil(DescArr[I]);
end;
{数据容器清空}
if Assigned(ImgInfoList) then
begin
ImgInfoList.Clear;
ImgInfoList := nil;
end;
end;
end.
浙公网安备 33010602011771号