Quellcode durchsuchen

附件,占用系统资源过多的问题

builder vor 5 Jahren
Ursprung
Commit
d9f9f0c495
3 geänderte Dateien mit 28 neuen und 1731 gelöschten Zeilen
  1. 1 1
      Forms/UpFileFrame.pas
  2. 0 1704
      Frames/ProjectFme.dfm
  3. 27 26
      Units/UpFileManageUnit.pas

+ 1 - 1
Forms/UpFileFrame.pas

@@ -70,7 +70,7 @@ var iW: Integer;
 begin
   FData := Value;
 
-  imgFile.Picture.Graphic := Data.Icon;
+  Data.AssignIcon(imgFile.Picture);
 
   iW := lblInfo.Left - lblFile.Left - 20;
 //  lblFile.AutoSize := True;

Datei-Diff unterdrückt, da er zu groß ist
+ 0 - 1704
Frames/ProjectFme.dfm


+ 27 - 26
Units/UpFileManageUnit.pas

@@ -27,7 +27,7 @@ type
     FWebFile: string;
     FMemo: string;
     FStatus: TUpFileStatus;
-    FIcon: TIcon;
+    //FIcon: TIcon;
     FBillID: Integer;
     FID: Integer;
     FCategory: string;
@@ -62,6 +62,8 @@ type
     function GetExt: string;
 
   public
+    procedure AssignIcon(APicture: TPicture);
+
     property No: Integer read FNo write SetNo;                                  // 索引号,进入TList的顺序号。
     property ID: Integer read FID write SetID;                                  // ID,主键
     property WebID: Integer read FWebID write SetWebID;                         // 服务器端的标段ID
@@ -76,7 +78,6 @@ type
     property LocalFile: string read FLocalFile write SetLocalFile;              // 本地文件:原始文件被统一管理后(单机版)或网络文件下载到本地后的文件。(完整路径+本地文件文件名)
     property DisplayName: string read FDisplayName write SetDisplayName;        // 本地显示给用户看的文件名。
     property DownURL: string read FDownURL write SetDownURL;                    // 下载链接,用于从服务器下载文件到本地
-    property Icon: TIcon read FIcon;                                            // 文件系统图标
     property Memo: string read FMemo write SetMemo;                             // 上传者的备注
     property Status: TUpFileStatus read FStatus write SetStatus;                // 状态信息,用于控制界面的显示
     property Ext: string read GetExt;
@@ -131,18 +132,6 @@ uses ProjectData, Forms, PHPWebDm, CslJson, ConstUnit, UtilMethods,
 
 { TUpFile }
 
-constructor TUpFile.Create;
-begin
-  inherited;
-  FIcon := TIcon.Create;
-end;
-
-destructor TUpFile.Destroy;
-begin
-  FIcon.Free;
-  inherited;
-end;
-
 procedure TUpFile.SetWebFile(const Value: string);
 begin
   FWebFile := Value;
@@ -371,20 +360,8 @@ begin
 end;
 
 procedure TUpFile.SetLocalFile(const Value: string);
-var
-  sExt: string;
-  sInfo: SHFILEINFO;
 begin
   FLocalFile := Value;
-
-  // 系统图标
-  sExt := ExtractFileExt(FLocalFile);
-  if sExt = '' then Exit;
-  FillChar(sInfo, SizeOf(sInfo), 0);
-  SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo),
-    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON);
-  if sInfo.hIcon > 0 then
-    FIcon.Handle := sInfo.hIcon;
 end;
 
 function TUpFiles.Add(ABillID: Integer): TUpFile;
@@ -453,4 +430,28 @@ begin
 end;
 
 
+procedure TUpFile.AssignIcon(APicture: TPicture);
+var
+  vIcon: TIcon;
+  sExt: string;
+  sInfo: SHFILEINFO;
+begin
+  // 系统图标
+  sExt := ExtractFileExt(FLocalFile);
+  if sExt = '' then Exit;
+  FillChar(sInfo, SizeOf(sInfo), 0);
+  SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo),
+    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON);
+  if sInfo.hIcon > 0 then
+  begin
+    vIcon := TIcon.Create;
+    try
+      vIcon.Handle := sInfo.hIcon;
+      APicture.Graphic := vIcon;
+    finally
+      vIcon.Free;
+    end;
+  end;
+end;
+
 end.