FMX制作长条图并在其图上写字美化等操作,delphi合并图片几分钟的事
一、原理
1、图上写字
AImage.Bitmap.Canvas.BeginScene;
AImage.Bitmap.Canvas.Font.Size:=32; //32:12号默认Memo字号对应写出来的size大小
AImage.Bitmap.Canvas.FillText(
ARect, //:在位图的哪个矩形区域写字
AText, //:要写的文字
true, //:可换行
1, //:不透明
[], //:写字的方向[TFillTextFlag.RightToLeft]:TFillTextFlags
TTextAlign.Leading,//:文字水平齐头
TTextAlign.Center //:文字垂直居中
);
AImage.Bitmap.Canvas.EndScene;
2、图片合并
ATImageTo.Bitmap.Canvas.BeginScene;
ATImageTo.Bitmap.Canvas.DrawBitmap(ATBitmap
,AScrTRectF //:裁剪原图的矩形区域
,ADstTRectF //:在指定的矩形区域显示出来
,1,false);
ATImageTo.Bitmap.Canvas.EndScene;
3、Bitmap的Size限制
//65535:=MaxAllowedBitmapSize=$FFFF=10000H-1,即十进制16^4-1=65535;
//:Windows下峰值65535:1080*1920*20(20张高1920的超高清蓝光图)
//:Windows下峰值38400:720*1280*30(30张高1920的高清图):TImage的画布实际可显示出来的最多只有22张
//:Android:峰值8160(宽720时的最大值):7680=宽720时高1280*6张=宽360时高640*12张
//:IOS:峰值3840(宽720时的最大值):3840=宽720时高1280*3张=宽360时高640*6张
//:超出峰值会报错:Bitmap Size too big
//:(宽720像素:一般高清手机拍照或截屏值,取决于手机设置)
//:(宽360像素时:屏幕放大后清晰度较差)
//:结论:图片以宽720像素按比例加载到TImage时:
//1280:是加载每张图的理想尺寸
4、分享
//FMX.Platform平台服务->FMX.MediaLibrary媒体库接口:
try
if TPlatformServices.Current
.SupportsPlatformService(
IFMXShareSheetActionsService,
IInterface(LFMXShareService)
) then
begin //两个动作只能2选1://Share第1个参数:本窗体内任意TControl:
//LFMXShareService.Share(Memo1,'我发的',nil); //:为空:执行前面的'我发的'
LFMXShareService.Share(AImage,'我发的',AImage.Bitmap);//:非空:执行后面的AImage.Bitmap
end;
finally
end;
二、代码
//D:\delphiXEDev\delphi半透明提示框\mergeImageAndWords
unit MergeImageAndWords;
interface
uses
System.SysUtils, System.Types, System.UITypes,
System.Classes, System.Variants, System.Math,
System.Generics.Collections,System.Generics.Defaults,
FMX.Types, FMX.Controls, FMX.Forms,
FMX.Graphics, FMX.Dialogs, FMX.Layouts,
FMX.StdCtrls, FMX.Controls.Presentation,
FMX.Objects, FMX.ScrollBox, FMX.Memo,
FMX.Edit, FMX.ExtCtrls, FMX.ListBox,
FMX.MediaLibrary,FMX.PlatForm, System.Actions, FMX.ActnList, FMX.StdActns,
FMX.MediaLibrary.Actions
;
type
TfmxMergeImageAndWords = class(TForm)
Layout1: TLayout;
Rectangle1: TRectangle;
ImgMerging03: TImage;
ImgMerging01: TImage;
ImgMerging02: TImage;
LayoutTools: TLayout;
btnMergeImgs: TSpeedButton;
btnMergeImgsSave: TSpeedButton;
ImgDrawed: TImage;
LayoutAll: TLayout;
ScrollBox1: TScrollBox;
btnHome: TSpeedButton;
StyleBook_MetropolisUIBlue: TStyleBook;
Memo1: TMemo;
Selection1: TSelection;
VertScrollBox1: TScrollBox;
ImageViewer1: TImageViewer;
ScrollBoxDecoratImg: TVertScrollBox;
btnDecoratImg: TSpeedButton;
ListBoxDecoratImg: TListBox;
ListBoxItemDecoratImg1: TListBoxItem;
ListBoxItemDecoratImg2: TListBoxItem;
ListBoxItemDecoratImg3: TListBoxItem;
ImgDecorat: TImage;
btnShare: TSpeedButton;
Memo2: TMemo;
procedure ControlAction(Sender: TObject);
procedure btnMergeImgsClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure ScrollBox1ViewportPositionChange(Sender: TObject;
const OldViewportPosition, NewViewportPosition: TPointF;
const ContentSizeChanged: Boolean);
procedure FormShow(Sender: TObject);
procedure Selection1Track(Sender: TObject);
procedure Memo1ChangeTracking(Sender: TObject);
private
{ Private declarations }
///<summary>存取路径:</summary>
FSavePath:string;
///<summary>控制是否滚动要在其中图片写字的当前ScrollBox:</summary>
FIfScrolling:Boolean;
///<summary>要在其中图片写字的当前ScrollBox视口:</summary>
FScrollBox1ViewportY:Single;
///<summary>要在其上写字的图片的当前Y向位置:</summary>
FImgMergingPositionY:Single;
///<summary>当前要在其上写字的图像控件:</summary>
FImg:TImage;
///<summary>写字的Memo控件当前的列数:</summary>
FMemoColums:Integer;
///<summary>写字的Memo控件当前的行数:</summary>
FMemoRows:Integer;
procedure FillImageText(AImage:TImage;AText:string);
procedure ShareImg(AImage:TImage);
public
{ Public declarations }
end;
function IfScrolling(
ACanScrollControl:TCustomScrollBox;
Scrolling:Boolean):Boolean;
procedure DrawLongImage(
var ATImageTo,ATImageFrom:TImage;
var AWidthTImageTo,AHeightTImageTo:Integer;
var ATBitmap:TBitmap; var AScrTRectF,ADstTRectF:TRectF );
var
fmxMergeImageAndWords: TfmxMergeImageAndWords;
implementation
uses
{$R *.fmx}
{$IFDEF ANDROID}
Androidapi.Helpers,
Androidapi.JNI.JavaTypes,
Androidapi.JNI.Os,
{$ENDIF}
FMX.DialogService,
myFuc_UnifiedPlatForm,
myFuc_Client
;
procedure TfmxMergeImageAndWords.btnMergeImgsClick(Sender: TObject);
var LTBitmap:TBitmap; LQuality:PBitmapCodecSaveParams;
LDstTRectF,LScrTRectF:TRectF;
LWidthTImageTo,LHeightTImageTo:Integer;
LFindImgList:TList<TImage>; LIComparerImgList:IComparer<TList<TImage>>;
LImgStrList:TStringList;
LResult:string;
//procedure EnumControls(const Proc: TFunc<TControl, TEnumControlsResult>); overload;
//function EnumControls(Proc: TEnumControlsRef; const VisibleOnly: Boolean = True): Boolean; overload;
//const Proc: TFunc<TFmxObject, TEnumProcResult>
function FindMergingImg:string;
Var LImagePrior,LImageCurrt:TImage;
LBitmapPriorHeight:Single;
LImageCount:Integer;
begin
LImageCurrt:=nil; LBitmapPriorHeight:=0; LResult:='';
//LFindImgList:=TList<FMX.Objects.TImage>.Create;
LImgStrList:=TStringList.Create;
ScrollBox1.EnumControls(
procedure (const AControl: TControl; var Done: boolean)
begin
if (AControl.ClassName = 'TImage') then
begin
//LImagePrior:=LImageCurrt;
LImageCurrt:=TImage(AControl);
//LFindImgList.Add(LImageCurrt);
LImgStrList.AddObject(LImageCurrt.Name,LImageCurrt);
//:加入TStringList以便全部加入完毕后进行排序
{
LScrTRectF.Top:=0;
LScrTRectF.Left:=0;
LScrTRectF.Bottom:=
ImgMerging01.Position.Point.Y+LImageCurrt.Bitmap.Height;
LScrTRectF.Right:=
ImgMerging01.Position.Point.X+LImageCurrt.Bitmap.Width;
if LImagePrior=nil then
begin
LDstTRectF.Top:=LScrTRectF.Top;
LDstTRectF.Left:=LImageCurrt.Position.Point.X;
LDstTRectF.Bottom:=LDstTRectF.Top +LScrTRectF.Bottom;
LDstTRectF.Right:=
LImageCurrt.Position.Point.X+LImageCurrt.Bitmap.Width;
end;// else
if LImagePrior<>nil then
begin
LBitmapPriorHeight:=LBitmapPriorHeight +LImagePrior.Bitmap.Height;
LDstTRectF.Top:=LScrTRectF.Top
+LBitmapPriorHeight //:该图上面所有合并图的高度
;
LDstTRectF.Left:=LImageCurrt.Position.Point.X;
LDstTRectF.Bottom:=LDstTRectF.Top +LScrTRectF.Bottom;
LDstTRectF.Right:=
LImageCurrt.Position.Point.X+LImageCurrt.Bitmap.Width;
end;
try
DrawLongImage(
ImgDrawed,LImageCurrt,
LWidthTImageTo,LHeightTImageTo,LTBitmap,LScrTRectF,LDstTRectF );
finally
end;
LResult:=LResult+'当前枚举的图是:'+LImageCurrt.Name+slinebreak;
}
end;
Done:=false;//:不要停继续找下一个
end
,true //:只枚举可见的组件
);
//LFindImgList.Sort; //:枚举类型只能按照索引号index排序
LImgStrList.Sorted:=true;
//:枚举完后按TStringList的Strings行次的名称进行排序
try
LImageCurrt:=nil;
for LImageCount:=0 to (LImgStrList.Count-1) do
begin
LImagePrior:=LImageCurrt;
LImageCurrt := TImage(LImgStrList.Objects[LImageCount]);
//剪切多大的矩形图:
LScrTRectF.Top:=0;
LScrTRectF.Left:=0;
LScrTRectF.Bottom:=
LImageCurrt.Position.Point.Y+LImageCurrt.Bitmap.Height;
LScrTRectF.Right:=
LImageCurrt.Position.Point.X+LImageCurrt.Bitmap.Width;
//在哪个目标位置矩形画图:
if LImagePrior=nil then
LBitmapPriorHeight:=LBitmapPriorHeight;
if LImagePrior<>nil then
LBitmapPriorHeight:=LBitmapPriorHeight +LImagePrior.Bitmap.Height;
LDstTRectF.Top:=LScrTRectF.Top
+LBitmapPriorHeight; //:该图上面所有合并图的高度
LDstTRectF.Left:=LImageCurrt.Position.Point.X;
LDstTRectF.Bottom:=LDstTRectF.Top +LScrTRectF.Bottom;
LDstTRectF.Right:=
LImageCurrt.Position.Point.X+LImageCurrt.Bitmap.Width;
try //开始画图:
DrawLongImage(
ImgDrawed,LImageCurrt,
LWidthTImageTo,LHeightTImageTo,LTBitmap,LScrTRectF,LDstTRectF );
finally
end;
LResult:=LResult+'枚举后排序的当前图是:'+LImageCurrt.Name+slinebreak;
end;
finally
//FreeAndNil(LFindImgList);
FreeAndNil(LImgStrList);
end;
if LImageCurrt<>nil then
Result:=LResult+'找到的最后1个排序图是:'+LImageCurrt.Name
else Result:='没图';
end;
begin
if FSavePath.Trim='' then
begin
{$IFDEF POSIX}
try
{$IFDEF Android}
//Memo1.Lines.Add(AndoidRequestPermissions('读取文件')); Memo1.Lines.Add(AndoidRequestPermissions('写入文件'));
AndoidRequestPermissions('读取文件');
AndoidRequestPermissions('写入文件');
{$ENDIF Android}
finally
SubPathOfAppPublished;
FSavePath:=GetSubPathOfAppPublished;
end;
{$ENDIF POSIX}
end;
{$IFDEF IOS}
LWidthTImageTo:=720; LHeightTImageTo:=3840;
{$ENDIF IOS} //3840:IOS最大值3张
{$IFDEF Android}
LWidthTImageTo:=720; LHeightTImageTo:=7680;
{$ENDIF Android} //7680:Android最大值6张
{$IFDEF MSWINDOWS}
LWidthTImageTo:=720; LHeightTImageTo:=28160;
{$ENDIF MSWINDOWS} //38400:Wondows最大值30张
System.TMonitor.Enter(ImgDrawed,0);
try
FindMergingImg;
//Memo1.Lines.Clear; Memo1.Lines.Add(FindMergingImg);
finally
ImgDrawed.Bitmap.SaveToFile(FSavePath+'ImgDrawed.jpg');
//:将文件保存到本地指定路径
end;
System.TMonitor.Exit(ImgDrawed);
VertScrollBox1.BringToFront; VertScrollBox1.Visible:=true;
end;
procedure DrawLongImage(
var ATImageTo,ATImageFrom:TImage;
var AWidthTImageTo,AHeightTImageTo:Integer;
var ATBitmap:TBitmap; var AScrTRectF,ADstTRectF:TRectF );
begin
if not Assigned(ATImageTo.Bitmap) then
begin
ATImageTo.Bitmap.Create;
//:需要传入的ATImageTo设计期:
//:设置一个虚拟图片来将其撑大大小为:
//:AWidthTImageTo,AHeightTImageTo
//:否则POSIX运行时的宽度显示不全
end;
try
ATBitmap:=TBitmap.Create;
ATBitmap.Width:=ATImageFrom.Bitmap.Width;
ATBitmap.Height:=ATImageFrom.Bitmap.Height;
ATBitmap.SetSize(ATBitmap.Width,ATBitmap.Height);
ATBitmap.Canvas.BeginScene; //:必须
ATBitmap.Canvas.DrawBitmap(ATImageFrom.Bitmap
,AScrTRectF //:裁剪原图的矩形区域
,AScrTRectF //:在原图矩形区域显示出来
,1,false);
ATBitmap.Canvas.EndScene;
ATImageTo.Bitmap.SetSize(AWidthTImageTo,AHeightTImageTo);
ATImageTo.Bitmap.Canvas.BeginScene;
ATImageTo.Bitmap.Canvas.DrawBitmap(ATBitmap
,AScrTRectF //:裁剪原图的矩形区域
,ADstTRectF //:在指定的矩形区域显示出来
,1,false);
ATImageTo.Bitmap.Canvas.EndScene;
finally
FreeAndNil(ATBitmap);
end;
end;
procedure TfmxMergeImageAndWords.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
fmxMergeImageAndWords:=nil;
Action:=TCloseAction.caFree;
//:窗体OnFormDestroy的时候:inherited会自动释放:窗体内的所有:
FreeAndNil(FDConnSQLite);// ClientModule1.FDManager1.DropConnections;
inherited;
end;
procedure TfmxMergeImageAndWords.FormCreate(Sender: TObject);
begin
FIfScrolling:=true;
VertScrollBox1.Visible:=false;
ListBoxDecoratImg.Visible:=false;
FScrollBox1ViewportY:=0;
FImgMergingPositionY:=0;
FImg:=nil;
Memo1ChangeTracking(Sender);
end;
procedure TfmxMergeImageAndWords.FormShow(Sender: TObject);
var CountComponent:Integer; ComponentName:string;
begin
ScrollBox1.BringToFront;
ComponentName:='';
//枚举设置显示方式及点击事件:fmxMergeImageAndWords.ScrollBox1
//{
for CountComponent:=0 to ComponentCount-1 do
begin
if Components[CountComponent] is TImage then
begin
ComponentName:=TImage(Components[CountComponent]).Name;
if ComponentName.IndexOf('ImgMerging',0,10)>=0 then
begin
//Memo1.Lines.Add(ComponentName);
TImage(Components[CountComponent]).BringToFront;
TImage(Components[CountComponent]).OnClick:=fmxMergeImageAndWords.ControlAction;
end;
end;
end; //}
Selection1.BringToFront;
//FMX.Controls.EnumControls枚举不全(同步枚举,非异步):
{ //FMX.Controls.EnumControls枚举不全(同步枚举,非异步):
fmxMergeImageAndWords.ScrollBox1.EnumControls(
procedure (const AControl: TControl; var Done: boolean)
begin
Done:=false;//:不要停继续找下一个
ComponentName:=AControl.Name;
if (AControl.ClassName = 'TImage') then
begin
//if (pos('ImgMerging',ComponentName)>0) then
if (ComponentName.IndexOf('ImgMerging',0,length(ComponentName))>=0) then
begin
AControl.BringToFront;
AControl.OnClick:=fmxMergeImageAndWords.ControlAction;
//ComponentName:=ComponentName+AControl.Name+SLineBreak;
Memo1.Lines.BeginUpdate;
Memo1.Lines.Add(ComponentName);
Memo1.Lines.EndUpdate;
end;
end;
end
,true //:只枚举可见的组件
);
//}
end;
procedure TfmxMergeImageAndWords.ScrollBox1ViewportPositionChange(
Sender: TObject;
const OldViewportPosition, NewViewportPosition: TPointF;
const ContentSizeChanged: Boolean);
begin
FScrollBox1ViewportY:=NewViewportPosition.Y;
// Memo1.Lines.BeginUpdate;
// Memo1.Lines.Add(FloatToStr(FScrollBox1ViewportY));
// Memo1.Lines.EndUpdate;
end;
procedure TfmxMergeImageAndWords.Selection1Track(
Sender: TObject);
begin
self.Caption:='合并多图片加文字描述'+
FloatToStr(Selection1.Position.Y);
end;
function IfScrolling(
ACanScrollControl:TCustomScrollBox;
Scrolling:Boolean):Boolean;
begin
if Scrolling=false then
begin
ACanScrollControl.AniCalculations.BeginUpdate;
ACanScrollControl.AniCalculations.Animation:=false;
ACanScrollControl.AniCalculations.BoundsAnimation:=false;
ACanScrollControl.AniCalculations.TouchTracking:=[];
ACanScrollControl.AniCalculations.EndUpdate;
Result:=false;
end else
begin
ACanScrollControl.AniCalculations.BeginUpdate;
ACanScrollControl.AniCalculations.Animation:=true;
ACanScrollControl.AniCalculations.BoundsAnimation:=true;
ACanScrollControl.AniCalculations.TouchTracking:=[ttVertical, ttHorizontal];
ACanScrollControl.AniCalculations.EndUpdate;
Result:=true;
end;
end;
procedure TfmxMergeImageAndWords.ControlAction(
Sender: TObject);
var Scene:IScene; LTControlName:string;
begin
if (Sender as TControl) is TSpeedButton then
begin
FocusMe(Sender as TControl);
if Sender=btnHome then close;
if Sender=btnMergeImgsSave then
begin
VertScrollBox1.Visible:=false; //:隐藏长条图预览合并
ScrollBoxDecoratImg.Visible:=false; //:隐藏长条图配文字
end;
if Sender=btnDecoratImg then
ListBoxDecoratImg.Visible:=true;
if Sender=btnShare then ShareImg(ImgDrawed);
//...... btnShare
end;
if (Sender as TControl) is TListBoxItem then
begin
if (Sender=ListBoxItemDecoratImg1) then
begin
Memo1.SelectAll;
Memo1.CopyToClipboard;
ListBoxDecoratImg.Visible:=false;
if Selection1.Position.Y=113 then
begin
Selection1.Position.Y:=112;
Selection1.Position.Y:=113;
end;
if Memo1.Lines.Text.Trim='' then
begin
ShowAMessage('请写好您要发布的文字!',procedure begin end);
Memo1.CanFocus:=true; Memo1.SetFocus;
exit;
end;
if FImg<>nil then
begin
Memo1.Lines.Clear;
Memo1.PasteFromClipboard;
//调用:长条图配文字代码:
FillImageText(FImg,Memo1.Lines.Text);
end else
begin
ShowAMessage('请点选图片!',procedure begin end);
end;
end;
end;
if (Sender as TControl) is TSelection then
begin
FocusMe(Sender as TControl);
FIfScrolling:=not FIfScrolling;
IfScrolling(ScrollBox1,FIfScrolling);
end;
if (Sender as TControl) is TImage then
begin
LTControlName:=(Sender as TControl).Name;
FocusMe(Sender as TControl);
if LTControlName.Indexof('ImgMerging',0,length(LTControlName))>=0 then
begin
ShowAMessage((Sender as TControl).Name+'获取了焦点',procedure begin end );
//Memo1.Lines.Add('图位'+FloatToStr((Sender as TControl).Position.Y)+sLineBreak);
FImgMergingPositionY:=(Sender as TControl).Position.Y;
FImg:=TImage(Sender as TControl);
end;
end;
end;
procedure TfmxMergeImageAndWords.Memo1ChangeTracking(Sender: TObject);
begin
Memo1.GoToTextBegin; Memo1.GoToLineEnd;
FMemoColums:=Memo1.CaretPosition.Pos;
if FMemoColums=0 then
FMemoRows:=0
else
FMemoRows:=Ceil(Length((Memo1.Text).Trim)/FMemoColums);
System.TMonitor.Enter(Memo2,0);
Memo2.Lines.Clear;
Memo2.Lines.Add('行'+IntToStr(Memo1.CaretPosition.Line+1)
+',列'+IntToStr(Memo1.CaretPosition.Pos));
System.TMonitor.Exit(Memo2);
end;
procedure TfmxMergeImageAndWords.FillImageText(
AImage:TImage;AText:string);
var ARect: TRectF; ImgPostGapY:Single;
begin
try
Memo1.StyledSettings:=Memo1.StyledSettings-[TStyledSetting.Other];
ImgPostGapY:=FImgMergingPositionY - FScrollBox1ViewportY;
ARect.Top:=
( Selection1.Position.Y
-(ImgPostGapY) ) *2
-48
;
//:2比例:原图与显示尺寸的比例：为AImage.Bitmap的高宽与其AImage的高宽
//:48为窗体顶部工具条LayoutTools的高度
ARect.Bottom:=ARect.Top+FMemoRows*56.96; //:=(纵横比=1.78)*字号Font.Size
ARect.Left:=(Selection1.Position.X)*2+20;//:20:左边界调整值
{$IFDEF POSIX}
ARect.Right:=720-20-ARect.Left;//720-20//:20*2:左边界调整值
{$ENDIF POSIX}
{$IFDEF MSWINDOWS}
if FMemoRows<=1 then
ARect.Right:=ARect.Left+(FMemoColums)*32
else
ARect.Right:=ARect.Left+(FMemoColums)*32-24*2-20;//720-20//:20*2:左边界调整值
{$ENDIF MSWINDOWS}
AImage.Bitmap.Canvas.BeginScene;
AImage.Bitmap.Canvas.Font.Size:=32; //32:12号默认Memo字号对应写出来的size大小
AImage.Bitmap.Canvas.FillText(
ARect, //:在位图的哪个矩形区域写字
AText, //:要写的文字
true, //:可换行
1, //:不透明
[], //:写字的方向[TFillTextFlag.RightToLeft]:TFillTextFlags
TTextAlign.Leading,//:文字水平齐头
TTextAlign.Center //:文字垂直居中
);
AImage.Bitmap.Canvas.EndScene;
finally
FImg:=nil;
end;
end;
procedure TfmxMergeImageAndWords.ShareImg(AImage:TImage);
var LFMXShareService:IFMXShareSheetActionsService;
begin
//FMX.Platform平台服务->FMX.MediaLibrary媒体库接口:
try
if TPlatformServices.Current
.SupportsPlatformService(
IFMXShareSheetActionsService,
IInterface(LFMXShareService)
) then
begin //两个动作只能2选1://Share第1个参数:本窗体内任意TControl:
//LFMXShareService.Share(Memo1,'我发的',nil);//:为空:执行前面的'我发的'
LFMXShareService.Share(AImage,'我发的',AImage.Bitmap);//:非空:执行后面的AImage.Bitmap
end;
finally
end;
end;
end.
三、关键要点
1、动态画图为何画出来的图宽度不足
if not Assigned(ATImageTo.Bitmap) then
begin
ATImageTo.Bitmap.Create;
//:需要传入的ATImageTo设计期:
//:设置一个虚拟图片来将其撑大，大小为:
//:AWidthTImageTo,AHeightTImageTo
//:否则POSIX运行时的宽度显示不全
end;
2、IOS读取和共享文件
四、运行效果
