分享
 
 
 

精心打造的New MMS Form

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

//功能:添加新的彩信数据到数据库

//作者:陈鹏

//完成日期:2005-80-31

unit newmmsForlibrary;

interface

uses

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

Dialogs, ImgList, xpWindow, Mask, RzEdit, RzSpnEdt, StdCtrls, RzCmboBx,

ExtCtrls, xpPanel, xpBitBtn, VirtualTrees, RzButton, RzRadChk,database,

Buttons,StrUtils;

type

TNewMMS = class(TForm)

CancelBtn: TxpBitBtn;

RightPanel: TBackPanel;

lblTitle: TLabel;

lblSubject: TLabel;

lblType: TLabel;

edtSubject: TEdit;

RCBType: TRzComboBox;

xpWindow1: TxpWindow;

ilImages: TImageList;

imgNewMsg: TImage;

VSTreeResource: TVirtualStringTree;

RzRadioButton1: TRzRadioButton;

RzRadioButton2: TRzRadioButton;

lblSmil: TLabel;

XpBtnAdd: TxpBitBtn;

XpBtnDelete: TxpBitBtn;

ResourceAdd:TxpBitBtn;

lblSize: TLabel;

edtsize: TEdit;

ilTreeImage: TImageList;

dlgOpenAdd: TOpenDialog;

procedure CancelBtnClick(Sender: TObject);

procedure XpBtnAddClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure ResourceAddClick(Sender: TObject);

procedure VSTreeResourceGetText(Sender: TBaseVirtualTree;

Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;

var CellText: WideString);

procedure XpBtnDeleteClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure edtSubjectMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

private

function getFilenameFromFullpath(s:string):string;

function getFileSize(sFileName:string):Longint;

procedure getMMSContentType();

public

totalSize:Longint;

Stringlist:TStringList;

procedure RefreshTree();

end;

type

PResource=^TResource;

TResource=record //彩信结构(好像没使用ClassID ,哈哈)

classID:string;

FullPath:string;

end;

var

NewMMS: TNewMMS;

implementation

uses

mmslibrarypage;

{$R *.dfm}

//功能:刷新树

procedure TNewMMS.RefreshTree();

begin

VSTreeResource.RootNodeCount:=Stringlist.Count;

VSTreeResource.Refresh;

end;

procedure TNewMMS.CancelBtnClick(Sender: TObject);

begin

close;

end;

procedure TNewMMS.XpBtnAddClick(Sender: TObject);

var

sql:string;

smiltype:string;

begin

if RzRadioButton1.Checked=true then

smiltype:='Smil 1.0'

else

smiltype:='Smil 2.0';

// sqL:='insert into mmslibrary(MMS_ID,MMS_Type,MMS_Smil,MMS_Size,MMS_Subject,MMS_Binary) values'+

// '("'+formatDatetime('yyyymmdd_hh:mm:ss', now)+'","'+RCbtype.Text+'","'+smiltype+'",'+edtsize.Text+',"'+

// edtIpSubject.Text+'","'+'test")';

//添加数据到数据库,但最后一项(二进制内存块) 还没添加

sqL:='insert into mmslibrary(MMS_ID,MMS_Type,MMS_Smil,MMS_Size,MMS_Subject) values'+

'("'+formatDatetime('yyyy-mm-dd hh:mm:ss', now)+'","'+RCbtype.Text+'","'+smiltype+'",'+inttostr(totalSize)+',"'+ edtSubject.Text+'")';

currentdatabase.ExecuteSqlNoQurey(sql); //连接数据库,就是这么容易

Close;

ModalResult:=mrOk;//据此,mmslibraryform才能刷新树。这也曾是一个难题,哈哈

end;

procedure TNewMMS.FormCreate(Sender: TObject);

begin

currentdatabase.databases.GetByIndex(0);

Stringlist:=Tstringlist.Create;

VSTreeResource.NodeDataSize:=SizeOf(TResource);

VSTreeResource.Header.Columns[0].Width:=VSTreeResource.ClientWidth;

totalSize:=0; //用户选择彩信资源的文件总大小

end;

procedure TNewMMS.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action:=caFree;

end;

procedure TNewMMS.ResourceAddClick(Sender: TObject);

var

temp:Longint;

begin

dlgOpenAdd.Filter:='text files(*.txt;*.html;*.htm)|*.txt;*.html;*.htm|pictual files(*.bmp;*.jpg;*.gif)|*.bmp;*.jpg;*.gif|sound files(*.wma;*.mp3)|*.wma;*.mp3|video files(*.avi;*.mp4)|*.avi;*.mp4|';

if dlgOpenAdd.Execute then

begin

temp:=totalSize+getFileSize(dlgOpenAdd.FileName);

if temp<102400 then //判断文件总大小不能超过100k,否则不予添加

begin

totalSize:=temp;

Stringlist.Add(dlgOpenAdd.FileName);

edtsize.Text:=IntToStr(totalSize)+' Byte';

end

else

Exit;

end;

RefreshTree;

getMMSContentType;

end;

//自写函数,根据用户选择的文件,自动判断MMS的Type,虽长且繁,但好维护(

procedure TNewMMS.getMMSContentType();

var

i:Integer;

extendname:string;

text,picture,sound,video:Integer;

begin

text:=0;

picture:=0;

sound:=0;

video:=0;

if Stringlist.Count=0 then RCBType.ItemIndex:=0;

for i := 0 to Stringlist.Count - 1 do

begin

extendname:=LowerCase( RightStr(Trim(Stringlist.Strings[i]),3));

if (extendname='txt') or (extendname='htm') or (extendname='tml') then

text:=text+1;

if (extendname='bmp') or (extendname='jpg') or (extendname='gif') then

picture:=picture+1;

if (extendname='wma') or (extendname='mp3') then

sound:=sound+1;

if (extendname='avi') or (extendname='mp4') then

video:=video+1;

end;

if (text>0) and (picture=0) and (sound=0) and (video=0) then

RCBType.ItemIndex:=0;

if (text=0) and (picture>0) and (sound=0) and (video=0) then

RCBType.ItemIndex:=1;

if (text>0) and (picture>0) and (sound=0) and (video=0) then

RCBType.ItemIndex:=2;

if (text=0) and (picture=0) and (sound>0) and (video=0) then

RCBType.ItemIndex:=3;

if (text>0) and (picture=0) and (sound>0) and (video=0) then

RCBType.ItemIndex:=4;

if (text=0) and (picture>0) and (sound>0) and (video=0) then

RCBType.ItemIndex:=5;

if (text>0) and (picture>0) and (sound>0) and (video=0) then

RCBType.ItemIndex:=6;

if (text=0) and (picture=0) and (sound=0) and (video>0) then

RCBType.ItemIndex:=7;

if (text>0) and (picture=0) and (sound=0) and (video>0) then

RCBType.ItemIndex:=8;

if (text=0) and (picture>0) and (sound=0) and (video>0) then

RCBType.ItemIndex:=9;

if (text>0) and (picture>0) and (sound=0) and (video>0) then

RCBType.ItemIndex:=10;

if (text=0) and (picture=0) and (sound>0) and (video>0) then

RCBType.ItemIndex:=11;

if (text>0) and (picture=0) and (sound>0) and (video>0) then

RCBType.ItemIndex:=12;

if (text=0) and (picture>0) and (sound>0) and (video>0) then

RCBType.ItemIndex:=13;

if (text>0) and (picture>0) and (sound>0) and (video>0) then

RCBType.ItemIndex:=14;

end;

//自写函数,获取文件的大小,值为Byte,故数据类型选择longint

function TNewMMS.getFileSize(sFileName:string):Longint;

var

Attrs: Word;

f: file of Byte;

size: Longint;

begin

Attrs := FileGetAttr(sFileName);

try

AssignFile(f, sFileName);

Reset(f);

size := FileSize(f);

finally

CloseFile(f);

end;

result:=size;

end;

procedure TNewMMS.VSTreeResourceGetText(Sender: TBaseVirtualTree;

Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;

var CellText: WideString);

var

i:Integer;

begin

for I := 0 to Stringlist.Count - 1 do

begin

case Column of

0: CellText:=getFilenameFromFullpath(Stringlist[node.index]);

end;

end;

end;

//自写函数,根据文件的绝对路径,得到包括了扩展名的文件名

function TNewMMS.getFilenameFromFullpath(s:string):string;

var

i:Integer;

temp:string;

begin

temp:=trim(s);

i:=Pos('\',temp);

while i<>0 do

begin

temp:=copy(temp,i+1,StrLen(PAnsiChar(temp))-i);

i:=Pos('\',temp);

end;

result:=temp;

end;

procedure TNewMMS.XpBtnDeleteClick(Sender: TObject);

var

node:PVirtualNode;

begin

if VSTreeResource.FocusedNode=nil then Exit;

node:=VSTreeResource.FocusedNode;

totalSize:=totalSize-getFileSize(Stringlist.Strings[node.index]);

edtsize.Text:=IntToStr(totalSize)+' Byte';

Stringlist.Delete(node.Index);

RefreshTree;

getMMSContentType;

end;

procedure TNewMMS.FormDestroy(Sender: TObject);

begin

stringlist.Free;

inherited;

end;

procedure TNewMMS.edtSubjectMouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

if edtsubject.Text='You can set a subject here' then

edtSubject.SetFocus;

end;

end.

『绝对原创 飞飞于北京 2005-08-31』

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
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- 王朝網路 版權所有