精心打造的New MMS Form - 王朝网络宽屏版

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

//作者：陈鹏

//完成日期：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

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;

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

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』