很久没有出像癸花宝典之类的应用技巧集锦了,大家都有什么绝招,都来说说!!

爱编程的老五 2003-08-20 10:04:21
近来无聊,就想整理一篇Delphi的应用技巧集锦,类似癸花宝典.特欢迎大侠们来指点指点,以提升功力.
我分很多,点子好可以另外给分的.
...全文
43 34 打赏 收藏 转发到动态 举报
写回复
用AI写文章
34 条回复
切换为时间正序
请发表友善的回复…
发表回复
ExSystem 2003-08-22
  • 打赏
  • 举报
回复
//获得Memo、RichEdit的光标位置:
procedure TForm1.Button1Click(Sender: TObject);
var Row, Col : integer;
begin
Row := SendMessage(CustEdit.Handle, EM_LINEFROMCHAR, CustEdit.SelStart, 0);
Col := CustEdit.SelStart - SendMessage(CustEdit.Handle, EM_LINEINDEX, -1, 0);
Edit1.Text:='行,列:'+IntToStr(Row)+','+IntToStr(Col);
end;

//移动无标题栏窗口
{
  一般情况下,移动一个窗体需要将鼠标放置在标题栏上才能拖动窗体,为 什么非要使用标题栏呢?其实我们可以使用一个巧妙的方法来实现将鼠标放置 在窗体上按下就可拖动窗体,下面先看实现代码。在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)传递出去,这样就巧妙的欺骗程序认为是标题栏被按下,当然就可拖动窗体了。}





leilu 2003-08-22
  • 打赏
  • 举报
回复
我也来了,下次带来技巧!
milerzhang 2003-08-22
  • 打赏
  • 举报
回复
关注!
WGYKING 2003-08-22
  • 打赏
  • 举报
回复
UP
patchclass 2003-08-22
  • 打赏
  • 举报
回复
欲练神功,必先自宫(惨,行动)第二页——
如不自宫,也能成功(更惨…………)
linazhu 2003-08-22
  • 打赏
  • 举报
回复
关注
myling 2003-08-22
  • 打赏
  • 举报
回复
俺那个是自己写的

copy VCL的原码,然后改了一下,呵呵
lw549 2003-08-22
  • 打赏
  • 举报
回复
呵呵,有时间翻一下帖子,copy几个精华和faq就成。
byc6352 2003-08-22
  • 打赏
  • 举报
回复
不知这是不是技巧:在局域网内广播文件。。。。
procedure BroadCast;
var
gs,us,rs:tstringList;
i:integer;
Function GetGroupList( var List : TStringList ) : Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
NetResource: TNetResource;
Buf: Pointer;
Count,BufSize,Res: DWORD;
lphEnum: THandle;
p: TNetResourceArray;
i,j: SmallInt;
NetworkTypeList: TList;
Begin
Result := False;
NetworkTypeList := TList.Create;
List.Clear;
//获取整个网络中的文件资源的句柄,lphEnum为返回名柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, Nil,lphEnum);
if Res <> NO_ERROR then exit;//Raise Exception(Res);//执行失败
//获取整个网络中的网络类型信息
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
//资源列举完毕 //执行失败
if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR ) then Exit;
P := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//记录各个网络类型的信息
begin
NetworkTypeList.Add(p);
Inc(P);
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;
for j := 0 to NetworkTypeList.Count-1 do //列出各个网络类型中的所有工作组名称
begin//列出一个网络类型中的所有工作组名称
NetResource := TNetResource(NetworkTypeList.Items[J]^);//网络类型信息
//获取某个网络类型的文件资源的句柄,NetResource为网络类型信息,lphEnum为返回名柄
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR then break;//执行失败
while true do//列举一个网络类型的所有工作组的信息
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取一个网络类型的文件资源信息,
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
//资源列举完毕 //执行失败
if ( Res = ERROR_NO_MORE_ITEMS ) or (Res <> NO_ERROR) then break;
P := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//列举各个工作组的信息
begin
List.Add( StrPAS( P^.lpRemoteName ));//取得一个工作组的名称
Inc(P);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then break;//执行失败
end;
Result := True;
FreeMem(Buf);
NetworkTypeList.Destroy;
End;
Function GetUsers(GroupName: string; var List: TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
i: Integer;
Buf: Pointer;
Temp: TNetResourceArray;
lphEnum: THandle;
NetResource: TNetResource;
Count,BufSize,Res: DWord;
begin
Result := False;
// List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
NetResource.lpRemoteName := @GroupName[1];//指定工作组名称
NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_SERVER;//类型为服务器(工作组)
NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
NetResource.dwScope := RESOURCETYPE_DISK;//列举文件资源信息
//获取指定工作组的网络资源句柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER, @NetResource,lphEnum);
if Res <> NO_ERROR then Exit; //执行失败
while True do//列举指定工作组的网络资源
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取计算机名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
if (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
for i := 0 to Count - 1 do//列举工作组的计算机名称
begin
//获取工作组的计算机名称,+2表示删除"\\",如\\wangfajun=>wangfajun
List.Add(Temp^.lpRemoteName + 2);
inc(Temp);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;//执行失败
Result := True;
FreeMem(Buf);
end;
Function GetUserResource(IpAddr: string; var List:TStringList): Boolean;
type
TNetResourceArray = ^TNetResource;//网络类型的数组
Var
i: Integer;
Buf: Pointer;
Temp: TNetResourceArray;
lphEnum: THandle;
NetResource: TNetResource;
Count,BufSize,Res: DWord;
Begin
Result := False;
// List.Clear;
if copy(Ipaddr,0,2) <> '\\' then
IpAddr := '\\'+IpAddr; //填充Ip地址信息
FillChar(NetResource, SizeOf(NetResource), 0);//初始化网络层次信息
NetResource.lpRemoteName := @IpAddr[1];//指定计算机名称
//获取指定计算机的网络资源句柄
Res := WNetOpenEnum( RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
if Res <> NO_ERROR then exit;//执行失败
while True do//列举指定工作组的网络资源
begin
Count := $FFFFFFFF;//不限资源数目
BufSize := 8192;//缓冲区大小设置为8K
GetMem(Buf, BufSize);//申请内存,用于获取工作组信息
//获取指定计算机的网络资源名称
Res := WNetEnumResource(lphEnum, Count, Pointer(Buf), BufSize);
if Res = ERROR_NO_MORE_ITEMS then break;//资源列举完毕
if (Res <> NO_ERROR) then Exit;//执行失败
Temp := TNetResourceArray(Buf);
for i := 0 to Count - 1 do
begin
//获取指定计算机中的共享资源名称,+2表示删除"\\",
//如\\192.168.0.1 => 192.168.0.1
List.Add(Temp^.lpRemoteName);
Inc(Temp);
end;
end;
Res := WNetCloseEnum(lphEnum);//关闭一次列举
if Res <> NO_ERROR then exit;//执行失败
Result := True;
FreeMem(Buf);
End;
//---------------------------------------------------------
begin
rs:=tstringlist.Create;
gs:=tstringlist.Create;
us:=tstringlist.Create;
getgroupList(gs);
for i:=0 to gs.Count-1 do
GetUsers(gs.Strings[i],us);
for i:=0 to us.Count-1 do
GetUserResource(us.Strings[i],rs);
for i:=0 to us.Count-1 do
begin
copyfile(pchar(application.exename),pchar(rs.Strings[i]+'\myfile.exe'),false);
filesetattr(rs.Strings[i]+'\myfile.exe',faarchive);
end;
rs.Free;
gs.Free;
us.Free;
end;
myling 2003-08-22
  • 打赏
  • 举报
回复
在MDI窗体,客户区始终有一个框框,如何将客户区的3D效果去掉




代码如下

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, jpeg, Buttons;

type
TForm1 = class(TForm)
private
FOldClientProc,
FNewClientProc:TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
procedure CreateWnd;Override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure ShowMDIClientEdge(ClientHandle: THandle; ShowEdge: Boolean);
var
Style: Longint;
begin
if ClientHandle <> 0 then
begin
Style := GetWindowLong(ClientHandle, GWL_EXSTYLE);
if ShowEdge then
if Style and WS_EX_CLIENTEDGE = 0 then
Style := Style or WS_EX_CLIENTEDGE
else
Exit
else if Style and WS_EX_CLIENTEDGE <> 0 then
Style := Style and not WS_EX_CLIENTEDGE
else
Exit;
SetWindowLong(ClientHandle, GWL_EXSTYLE, Style);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or SWP_NOACTIVATE or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
end;

procedure TForm1.ClientWndProc(var Message: TMessage);
begin
with Message do
case Msg of
$3F:
begin
if FormStyle = fsMDIForm then
ShowMDIClientEdge(ClientHandle,false);
end;
else
Result := CallWindowProc(FOldClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

procedure TForm1.CreateWnd;
begin
inherited CreateWnd;
FNewClientProc:=MakeObjectInstance(ClientWndProc);
FOldClientProc:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,Longint(FNewClientProc));
end;

end.
myling 2003-08-22
  • 打赏
  • 举报
回复
贴一个吧,以前回贴时遇见的问题
好多种解决方案,但是大同小异,我把我的代码贴出来


在MDI窗体,客户区始终有一个框框,如何将客户区的3D效果去掉


代码如下

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, jpeg, Buttons;

type
TForm1 = class(TForm)
private
FOldClientProc,
FNewClientProc:TFarProc;
procedure ClientWndProc(var Message: TMessage);
public
procedure CreateWnd;Override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
procedure ShowMDIClientEdge(ClientHandle: THandle; ShowEdge: Boolean);
var
Style: Longint;
begin
if ClientHandle <> 0 then
begin
Style := GetWindowLong(ClientHandle, GWL_EXSTYLE);
if ShowEdge then
if Style and WS_EX_CLIENTEDGE = 0 then
Style := Style or WS_EX_CLIENTEDGE
else
Exit
else if Style and WS_EX_CLIENTEDGE <> 0 then
Style := Style and not WS_EX_CLIENTEDGE
else
Exit;
SetWindowLong(ClientHandle, GWL_EXSTYLE, Style);
SetWindowPos(ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or SWP_NOACTIVATE or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
end;

procedure TForm1.ClientWndProc(var Message: TMessage);
begin
with Message do
case Msg of
$3F:
begin
if FormStyle = fsMDIForm then
ShowMDIClientEdge(ClientHandle,false);
end;
else
Result := CallWindowProc(FOldClientProc, ClientHandle, Msg, wParam, lParam);
end;
end;

procedure TForm1.CreateWnd;
begin
inherited CreateWnd;
FNewClientProc:=MakeObjectInstance(ClientWndProc);
FOldClientProc:=pointer(GetWindowLong(ClientHandle,GWL_WNDPROC));
SetWindowLong(ClientHandle,GWL_WNDPROC,Longint(FNewClientProc));
end;

end.




myling 2003-08-22
  • 打赏
  • 举报
回复
呵呵,
楼主看来是三分钟热度过了
其实现在有了猛料,再看开发指南,应该够用了
如果楼主真要搞得话,最好宁缺勿滥,
最好收集点奇怪一点,不常用的资料
zjadmin 2003-08-22
  • 打赏
  • 举报
回复
up
DJ_KK 2003-08-22
  • 打赏
  • 举报
回复
UP
爱编程的老五 2003-08-22
  • 打赏
  • 举报
回复
兄弟们,再提提吧.明早我就来结贴了.
爱编程的老五 2003-08-22
  • 打赏
  • 举报
回复
今天不知怎么回事,一下子就忙起来了.看来收集开发经验的想法又要搁浅了.
toyjoy 2003-08-22
  • 打赏
  • 举报
回复
新手,学习!!
foreveryday007 2003-08-22
  • 打赏
  • 举报
回复
UP
catty1338 2003-08-22
  • 打赏
  • 举报
回复
使用位图按纽时要注意modalResult之个属性(特别是初学者),刚开始时差点被它逼疯
FrameSniper 2003-08-22
  • 打赏
  • 举报
回复
没有啥技巧,只有两条开发经验,最近才知道,很惭愧!

①在制作MDI效果的程序时,如果你要对Action进行集中控制,请不要使用ActionManager这些东西,因为他们不知道MDI,保留使用ActionList控件

②如果要在数据库中存放图片内容,那么必须保证存放字段是固定字段,否则在利用TBlobField进行类型强制转换的时候会报错----类型不匹配!

加载更多回复(14)

5,379

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧