分享
 
 
 

动态贺卡EXE生成器---Delphi中流的应用(9)

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

<<电脑商情报>>已经连载到此节了:)

http://lovejingtao.126.com

三、实际应用之二:利用流制作可执行电子贺卡

我们经常看到一些电子贺卡之类的制作软件,可以让你自己选择图片,然后

它会生成一个EXE可执行文件给你。打开贺卡时就会一边放音乐一边显示出图片来。

现在学了流操作之后,我们也可以做一个了。

添加图片过程我们可以直接用前面的Cjt_AddtoFile,而现在要做的是如何把

图像读出并显示。我们用前面的Cjt_LoadFromFile先把图片读出来保存为文件再

调入也是可以的,但是还有更简单的方法,就是直接把文件流读出来显示,有了

流这个利器,一切都变的简单了。

现在的图片比较流行的是BMP格式和JPG格式。我们现在就针对这两种图片写

出读取并显示函数。

Function Cjt_BmpLoad(ImgBmp:TImage;SourceFile:String):Boolean;

var

Source:TFileStream;

MyFileSize:integer;

begin

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);

try

try

Source.Seek(-sizeof(MyFileSize),soFromEnd);

Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));//读出资源

Source.Seek(-MyFileSize,soFromEnd);//定位到资源开始位置

ImgBmp.Picture.Bitmap.LoadFromStream(Source);

finally

Source.Free;

end;

except

Result:=False;

Exit;

end;

Result:=True;

end;

上面是读出BMP图片的,下面的是读出JPG图片的函数,因为要用到JPG单元,所

以要在程序中添加一句:uses jpeg。

Function Cjt_JpgLoad(JpgImg:Timage;SourceFile:String):Boolean;

var

Source:TFileStream;

MyFileSize:integer;

Myjpg: TJpegImage;

begin

try

Myjpg:= TJpegImage.Create;

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareDenyNone);

try

Source.Seek(-sizeof(MyFileSize),soFromEnd);

Source.ReadBuffer(MyFileSize,sizeof(MyFileSize));

Source.Seek(-MyFileSize,soFromEnd);

Myjpg.LoadFromStream(Source);

JpgImg.Picture.Bitmap.Assign(Myjpg);

finally

Source.Free;

Myjpg.free;

end;

except

Result:=false;

Exit;

end;

Result:=true;

end;

有了这两个函数,我们就可以制作读出程序了。下面我们以BMP图片为例:

运行Delphi,新建一个工程,放上一个显示图像控件Image1。在窗口的Create

事件中写上一句就可以了:

Cjt_BmpLoad(Image1,Application.ExeName);

这个就是头文件了,然后我们用前面的方法生成一个head.res资源文件。

下面就可以开始制作我们的添加程序了。全部代码如下:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, StdCtrls, ExtDlgs;

type

TForm1 = class(TForm)

Edit1: TEdit;

Button1: TButton;

Button2: TButton;

OpenPictureDialog1: TOpenPictureDialog;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

Function ExtractRes(ResType, ResName, ResNewName : String):boolean;

Function Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

Function TForm1.ExtractRes(ResType, ResName, ResNewName : String):boolean;

var

Res : TResourceStream;

begin

try

Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));

try

Res.SavetoFile(ResNewName);

Result:=true;

finally

Res.Free;

end;

except

Result:=false;

end;

end;

Function TForm1.Cjt_AddtoFile(SourceFile,TargetFile:string):Boolean;

var

Target,Source:TFileStream;

MyFileSize:integer;

begin

try

Source:=TFileStream.Create(SourceFile,fmOpenRead or fmShareExclusive);

Target:=TFileStream.Create(TargetFile,fmOpenWrite or fmShareExclusive);

try

Target.Seek(0,soFromEnd);//往尾部添加资源

Target.CopyFrom(Source,0);

MyFileSize:=Source.Size+Sizeof(MyFileSize);//计算资源大小,并写入辅程尾部

Target.WriteBuffer(MyFileSize,sizeof(MyFileSize));

finally

Target.Free;

Source.Free;

end;

except

Result:=False;

Exit;

end;

Result:=True;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Caption:='Bmp2Exe演示程序.作者:陈经韬';

Edit1.Text:='';

OpenPictureDialog1.DefaultExt := GraphicExtension(TBitmap);

OpenPictureDialog1.Filter := GraphicFilter(TBitmap);

Button1.Caption:='选择BMP图片';

Button2.Caption:='生成EXE';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if OpenPictureDialog1.Execute then

Edit1.Text:=OpenPictureDialog1.FileName;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

HeadTemp:String;

begin

if FileExists(Edit1.Text) then

begin

Application.MessageBox('BMP图片文件不存在,请重新选择!','信息',MB_ICONINFORMATION+MB_OK)

Exit;

end;

HeadTemp:=ChangeFileExt(Edit1.Text,'.exe');

if ExtractRes('exefile','head',HeadTemp) then

if Cjt_AddtoFile(Edit1.Text,HeadTemp) then

Application.MessageBox('EXE文件生成成功!','信息',MB_ICONINFORMATION+MB_OK)

else

begin

if FileExists(HeadTemp) then DeleteFile(HeadTemp);

Application.MessageBox('EXE文件生成失败!','信息',MB_ICONINFORMATION+MB_OK)

end;

end;

end.

怎么样?很神奇吧:)把程序界面弄的漂亮点,再添加一些功能,你会发现比

起那些要注册的软件来也不会逊多少吧。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有