项目经验交流（CODE)

Question

工作了两年，在以往的项目中，或多或少的会碰到一些技术上的难题，然后翻阅资料，直到解决，但好东东不该独享，虽然谈不上什么经典，但也许会解决大家日常中的燃眉之急吧 呵呵````````用LISTVIEW显示表中的信息：
procedure viewchange(listv:tlistview;table:tcustomadodataset;var i:integer);
 begin
       tlistview(listv).Items.BeginUpdate;
        try
          tlistview(listv).Items.Clear;
          with table do
           begin
            active:=true;
            first;
            while not eof do
             begin
              listitem:=tlistview(listv).Items.add;
              listitem.Caption:=trim(table.fields[i].asstring);
              listitem.ImageIndex:=8;
             next;
             end;
        end;
        finally
        tlistview(listv).Items.EndUpdate;
      end;
 end;

Answer 1

按回车键，自定义触发BUTTON
procedure enter(button:tbutton;var key:word);
begin
 if key=13 then
    tbutton(button).Click;
end;

Answer 2

处理单击LISTVIEW时，如果没有选中ITEM的错误负值：
procedure oneclick(listv:tlistview);
var
I:integer;
begin
if tlistview(listv).Selected=nil then
 begin
   list:='';
   abort;
 end;
try
  I:=tlistview(listv).Selected.Index;
  except
 // list:='';
 // mycaption:='';
 // abort;
end;
 try list:=trim(tlistview(listv).Items.Item[I].Caption);
 mycaption:=trim(tlistview(listv).Items.Item[I].Caption);
 except
 end;
end;

Answer 3

function findmdiwindow:boolean;
begin
 if application.MainForm.MDIChildCount>0 then   //判断是否有子窗体存在
  result:=true
  else
   result:=false;
end;

Answer 4

应该是
procedure enter(button:tbutton;var key:word);
begin
 if key=13 then
 begin 
   key:= 0; 
   tbutton(button).Click;
 end;
end;

Answer 5

VB中读取INI文件
Private Sub Form_Load()
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(App.Path & "\init.txt") Then
        Set a = fs.opentextfile(App.Path & "\init.txt")
        con_str = a.readline
        a.Close
        conn.ConnectionString = con_str
        conn.Open
        b_ip = InStr(1, con_str, "server=") + 7
        e_ip = InStr(b_ip, con_str, ";")
        server_ip = Mid(con_str, b_ip, e_ip - b_ip)
    Else
        frm_database.Show 1
        If Len(ip) = 0 Then End
        If server_client = "ser" Then
            con_str = "driver=SQL Server;server=" & ip & ";database=master;uid=sa;pwd="
            conn.ConnectionString = con_str
            conn.CommandTimeout = 15
            conn.Open
            conn.Execute "exec sp_attach_db plat_xyj,'" & App.Path & "\plat_Data.MDF','" & App.Path & "\plat_Log.LDF'"
            conn.Close
        End If
        con_str = "driver=SQL Server;server=" & ip & ";database=plat_xyj;uid=sa;pwd="
        conn.ConnectionString = con_str
        conn.CommandTimeout = 15
        conn.Open
        server_ip = ip
        Set a = fs.CreateTextFile(App.Path & "\init.txt", True)
        a.writeline con_str
        a.Close
    End If
    client_ip = Winsock1.LocalIP
    Combo1.ListIndex = 3
    Set rs = conn.Execute("select name from p_user order by id")
    While Not rs.EOF
        If Not IsNull(rs!Name) And Trim(rs!Name) <> "" Then
            Combo2.AddItem Trim(rs!Name)
        End If
        rs.MoveNext
    Wend
End Sub

Answer 6

fengjn(小枫) :我这样写得也执行过去了。
不过在ACCESS（VB）中作开发的话，就要屏蔽一些系统键了，比如F5之类的

Answer 7

1. 将popmenu 的几个事件写在一块，可以适当减少代码冗余
2. 能使用tquery的情况下尽量不要使用Ttable 
3. 整个程序只放置一个tdatabase 来连接一个服务器,这是初学者
经常可能出错的地方
4. 将业务和界面控制分离,这是我一直想达到却怎么也完全达不到到的一
个目标
5. 程序的不同模块之间尽量使用函数的方式来通信,尽量不用使用共享变量
个人感觉,不一定是准则,大家看着拍砖,不要砸死人就行

Answer 8

缩小步长
在设计窗体时使用“（靠到格线）Snap to grid”功能，可以节省安置组件的时间，但是，有时你还需要微调其位置和大小。
其一：将组件在窗体上一次移动一个象素点。首先，选中你想移动的组件，然后，按下<Ctrl>键不放，按光标键，选中的控制将一次移动一个象素点，方向与光标键所指方向相同。
其二：每次按一个象素点调整控制的大小。选中控制，按下<Shift>键不放，按光标键，根据光标键所指方向不同，选中的控制每次放大或缩小一个象素点。

Answer 9

标签的加速键
对含有Caption属性的组件，添加快捷键是比较容易的，只需在Caption属性中特定字符前加上“&”符号即可。那么，怎样给没有Caption属性的控制添加快捷键呢？现以给一个TMemo控制添加快捷键为例说明如下：在窗体上放置一个TMemo控制，再在其旁边放置一个TLabel控制，将其Caption属性设置为“&Memo1”，将TLabel的FocusControl属性设置为“Memo1”。编译并运行这个程序，按快捷键 <ALT+M>，就可以快速存取Memo1控制的内容。这项技术不需要任何代码，可以应用到所有没有Caption属性的控件上。
呵呵 很不错的方法

Answer 10

处理自己的热键
向窗体添加自己的热键：将窗体的KeyPreview属性设置为True，然后在窗体的OnKeyDown事件处理程序中添加如下代码：
if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then ShowMessage('Ctrl-A');
就OK了

Answer 11

让你的程序只运行一次！！！！！！！！！！
 const mypro='tmainapp';//FORM名
 var handle:integer;
begin
  handle:=findwindow(mypro,nil);
  if handle<>0 then
   begin
    messagebox(0,'程序正在运行,请关闭','警告',0);
    halt;
   end;

Answer 12

TO fengjn(小枫) 
我会改进的 谢谢：）

Answer 13

function findmdiwindow:boolean;
begin
 if application.MainForm.MDIChildCount>0 then   //判断是否有子窗体存在
  result:=true
  else
   result:=false;
end;
可以这样function findmdiwindow:boolean;
begin
 Result:=application.MainForm.MDIChildCount>0;   //判断是否有子窗体存在
end;

Answer 14

欢迎参与我这个类似的帖子。
http://expert.csdn.net/Expert/topic/2056/2056908.xml?temp=.1589777

Answer 15

不用标题栏也移动窗体
一般情况下，移动一个窗体需要将鼠标放置在标题栏上才能拖动窗体，下面代码功能是在窗体上按下就可拖动窗体。在Form1的"Private"部分声明过程：
在private部分加入下列代码：
procedure wmnchittest(var msg:twmnchittest);
message wm_nchittest;
在程序部分加入以下代码：
procedure TForm1.wmnchittest(var msg:twmnchittest);
begin
inherited;
if (htclient=msg.result) then msg.result:=htcaption;
end;
　　上面的关键代码虽然只有两行，但它实现了鼠标直接拖动窗体的目的。代码的原理是利用窗体的WM_NCHITTEST消息，这个消息是当光标移动、鼠标按下或释放时发生的，当程序检测到鼠标在窗体中按下的消息后（消息的值为htClient），将鼠标在标题栏上按下时产生的消息（值为htCaption）传递出去，这样就巧妙的欺骗程序认为是标题栏被按下，当然就可拖动窗体了。 
：）

Answer 16

TREEVIEW的使用
基本信息:
TreeView 是一个显示树型结构的控件
每一个节点都是一个新类
使用具有代表性
每个节点都有四个值:
TEXT:显示文字 Image Index:显示图形序号
Selected Index:
State Index:
(1)建立目录项(本例中使用的TREEVIEW名称为:TvwTips)
增加根目录下的节点:(节点)
var
CatNode : TTreeNode; //先建立一个TREEVIEW使用的子对象
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
{ 在根标题下建立一个新的子标题 }
CatNode := TvwTips.Items.AddChild(TvwTips.Items.GetFirstNode'New Category' );
CatNode.ImageIndex := 1;
CatNode.SelectedIndex := 2;
CatNode.EditText; { 允许用户改变这个标题 }
end;
增加下一级目录(内容):
var
ParentNode
TipNode : TTreeNode; //先建立TREEVIEW使用
的子对象
VersionNum : Integer;
begin
TvwTips.SetFocus; //将焦点置到这个TREEVIEW控件上
VersionNum := TMenuItem( Sender ).Tag; { Ver num of new tip }
ParentNode := TvwTips.Selected; { 取出当前的选中节点 }
if ParentNode.Level = nlTip then{ Parent cannot be a tip node }
ParentNode := TvwTips.Selected.Parent;
TipNode := TvwTips.Items.AddChildObject( ParentNode
'New
Subject'
Pointer( VersionNum ) );
TipNode.ImageIndex := 3; { Normal tip bitmap }
TipNode.SelectedIndex := 4; { Highlighted tip bitmap }
TipNode.MakeVisible; { Move new tip node into view }
TipNode.EditText; { Immediately allow user to edit subject }
EnableTreeViewFunctions( TipNode.Level );
RtfTip.Clear;
RtfTip.Modified := False;
end;
(2)说明
TvwTips.Items.GetFirstNode 返回TREEVIEW的第一个节点
函数类型为:TTreeNode
TvwTips.Items.Count 返回当前TreeView的全部节点数
整数
TvwTips.Selected.Level 返回当前选中节点的在目录树中的级别
根目录为0
TvwTips.Selected.Parent 返回当前选中节点上级节点
函数类型为:TTreeNode

Answer 17

自己在写程序过程中用到了TNMFtp，于是就自己写了两个过程，实现下载和上传：
procedure ex_download(remote_dir,remote_file:string);
var
localfname:string;
begin
 datamodule2.NMFTP1.Connect;
 try  datamodule2.NMFTP1.ChangeDir(remote_dir);
   begin
    if nod='&#65416;&#65423;&#65430;&#65380;&#65414;&#65405;&#65420;&#65384;' then
      localfname:=remote_file
    else
      localfname:=mycaption;
      datamodule2.NMFTP1.Download(remote_file,FRootPath+remote_file);
   end
    except
    On E:Exception do begin
       showmessage('下在失败，请检查文件是否存在，或网络是否已断开');
    end;
   end;
 datamodule2.NMFTP1.Disconnect;
end;procedure ex_upload(remote_dir:string;atable:tcustomadodataset;fieldname:string);
var
remotefname,localfname:string;
label lab;
begin
 begin
 datamodule2.NMFTP1.Connect;
 try if not DirectoryExists('ftp://'+trim(sysshezhi.edtAddress.text)+'/'+remote_dir) then
    datamodule2.nmftp1.MakeDirectory(remote_dir);
    except
    On E:Exception do begin
    end;end;
    datamodule2.NMFTP1.ChangeDir(remote_dir);
lab: if datamodule2.OpenDialog1.Execute then
       begin
        temp_dir:='ftp://'+trim(sysshezhi.edtAddress.Text)+'/'+remote_dir;
        localfname:=datamodule2.OpenDialog1.FileName;
        remotefname:=extractfilename(localfname);
        remotefnam:=remotefname;
        if remotefname='' then
         begin
          showmessage('没选中文件！请重新选择');
          goto lab;
         end
           else
            begin
             if findfile(atable,remotefnam,fieldname) then
               begin
                if MessageDlg('文件已存在，覆盖吗？',mtConfirmation, [mbYes, mbNo], 0) = mrYes then
                  begin
                   bool:=true;
                   ins:=false;
                   datamodule2.NMFTP1.upload(localfname,remotefname);
                  end
                   else
                    begin
                     bool:=false;
                     messagebox(0,'上传取消','提示!',0);
                   end;
                end;
             if not findfile(atable,remotefnam,fieldname) then
               begin
                bool:=true;ins:=true;
                datamodule2.NMFTP1.upload(localfname,remotefname);
               end;
            end;
        end;
 end;
因为程序时作项目的时候写的，所以里面又TABLE：）
机制是：本地显示数据库里的内容，数据库里的内容是记录了上传的信息。

Answer 18

利用TNMFTP删除服务器的文件
procedure del_file(remote_dir,filename:string);
begin
  datamodule2.NMFTP1.Connect;
  datamodule2.NMFTP1.ChangeDir(remote_dir);datamodule2.NMFTP1.Delete(filename);
   if fileexists(filename) then
    begin
     if  deletefile(pchar(filename)) then
       showmessage('文件已删除')
      else showmessage('无法删除文件，请检查网络或查看权限分配');end else
    showmessage('要删除的文件不存在，操作无法完成');
   datamodule2.NMFTP1.disconnect;
end;

Answer 19

VB中自动生成单号
Public Function get_CoOutDrictionNo(enterdate As Date)
 Dim Label1 As Label
 Dim has As Boolean
 Dim pub_str3, mon As String
 mon = Mid(enterdate, 6, 2)  '取日期的月份
 pub_str1 = "select chr_CoDirectionID from AST_CoDirection where left(chr_CoDirectionID,5)='M" & Right(Year(enterdate), 2) & "" & "" & mon & "' group by chr_CoDirectionID"
init_rst  '调用初始化RECORDSET
 mod_ast.rst.Open pub_str1, CurrentProject.Connection, adOpenDynamic, adLockBatchOptimistic, adCmdText
 If mod_ast.rst.RecordCount = 0 Then '如果没有M03*****的记录则从001开始  编码规则:M0307001
     get_CoOutDrictionNo = "M" + Right(Year(enterdate), 2) + mon + "001"
   Exit Function
   End If
 mod_ast.rst.MoveLast
 get_CoOutDrictionNo = Left(mod_ast.rst.Fields(0), 5) + Right(Str(Val(Right(Trim(mod_ast.rst.Fields(0)), 3)) + 1001), 3) '存在记录则+1
 End Function

Answer 20

好贴，我也来一点关于拖动窗口还有更好的办法，适用于拖动作意控件procedure TForm1.ControlMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
const
   SC_DragMove = $F012;  //拖动   //$F020  最小化
begin
   ReleaseCapture;
   (Sender as TWinControl).Perform(WM_SysCommand, SC_DragMove, 0);
end;把任何从TWinControl下来的控件或窗口的鼠标移动事件指向这个过程即可拖动