转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
精心打造的New MMS Form         ★★★★

精心打造的New MMS Form

作者:闵涛 文章来源:闵涛的学习笔记 点击数:1816 更新时间:2009/4/23 18:26:19

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

//作者:陈鹏

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

[1] [2]  下一页


没有相关教程
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台