Fdmemtable 内存表保存图片的例子

复制代码
 1 var
 2   aStream: TMemoryStream;
 3   LDataSet: TFDDataSet; // 申请一个FD数据集
 4   MyStream: Tmemorystream;
 5   MyJPEG: TJpegImage;
 6   MyPng: TPngImage;
 7 begin
 8   inherited;
 9   if img2.Picture.Graphic = nil then
10   begin
11     Application.MessageBox('没有图片可以增加!!', '提示', MB_OK + MB_ICONWARNING + MB_TOPMOST);
12 
13   end
14   else
15   begin
16     aStream := TMemoryStream.Create();
17     MyStream := TMemoryStream.Create();
18     try
19       img2.Picture.SaveToStream(aStream);
20       fdmtPicture.Append;
21       fdmtPicture.FieldByName('p_picture_id').AsLargeInt := getSnowflake;
22       fdmtPicture.FieldByName('p_picture_guid').AsString := GetGUID;
23       fdmtPicture.FieldByName('p_products_id').AsLargeInt := aid;
24       fdmtPicture.FieldByName('p_picture_name').AsString := EditImageName.Text;
25       if img2.Picture.Graphic is TJPEGImage then
26       begin
27         MyJPEG := TJpegImage.Create;
28         MyJPEG.Assign(img2.Picture.Graphic);
29         MyJPEG.CompressionQuality := 10;
30         MyJPEG.Compress;
31         MyJPEG.SaveToStream(MyStream);
32       end;
33       if img2.Picture.Graphic is TPngImage then
34       begin
35         MyPng := TPngImage.Create;
36         MyPng.Assign(img2.Picture.Graphic);
37         MyPng.CompressionLevel := 9;
38         MyPng.SaveToStream(MyStream);
39       end;
40       MyStream.Position := 0;
41       TBlobField(fdmtPicture.FieldByName('p_picture_thumbnail')).LoadFromStream(MyStream);
42       aStream.Position := 0;
43       TBlobField(fdmtPicture.FieldByName('p_picture_image')).LoadFromStream(aStream);
44       fdmtPicture.Post;
45       img2.Picture.Graphic := nil;
46     finally
47       MyStream.free;
48       aStream.Free;
49     end;
50   end;
复制代码

 

posted @   Thenext  阅读(157)  评论(0编辑  收藏  举报
相关博文:
阅读排行:
· 分享一个免费、快速、无限量使用的满血 DeepSeek R1 模型,支持深度思考和联网搜索!
· 使用C#创建一个MCP客户端
· 基于 Docker 搭建 FRP 内网穿透开源项目(很简单哒)
· ollama系列1:轻松3步本地部署deepseek,普通电脑可用
· 按钮权限的设计及实现
历史上的今天:
2021-06-29 SQL Server 断开某个数据库所有连接(还原的时候需要)转自用保留
2019-06-29 虚拟机安装Lubuntu
点击右上角即可分享
微信分享提示