★有事没事多散分★

zdcnow 2003-04-22 12:23:58
unit faq;

//用TImage,Ado读和写Sql Server或者Access数据库中图片(bmp或者jpg格式都可以)字段的源代码:
http://www.csdn.net/expert/topic/973/973247.xml?temp=.441189

//改动hint时间
application.HintHidePause:=10000;//10秒

//提取图标转换为bmp
use shellapi;

procedure TForm1.Button1Click(Sender: TObject);
var
hc: TIcon;
Bitmap : TBitmap;
begin
//打开exe
opendialog1.Execute;
hc := TIcon.Create;
Bitmap := TBitmap.Create;
//提取exe图标
hc.Handle := ExtractIcon(hInstance, PChar(opendialog1.FileName), 0);
//将得到的ico转换为bitmap
Bitmap.Width := hc.Width;
Bitmap.Height := hc.Height;
Bitmap.Canvas.Draw(0, 0, hc );
//把bitmap传给speedbutton.glyph
SpeedButton1.Glyph:=bitmap;
//释放资源
hc.Free;
Bitmap.Free;
end;

//任务栏
//隐藏
Var
WndHandle: THandle;
WndClass: array[0..50] of char;
begin
StrPCopy(@WndClass[0], 'Shell_TrayWnd');
WndHandle := FindWindow(@WndClass[0], nil);
ShowWindow(WndHandle, SW_HIDE);
end;
//显示
Var
WndHandle: THandle;
WndClass: array[0..50] of char;
begin
StrPCopy(@WndClass[0], 'Shell_TrayWnd');
WndHandle := FindWindow(@WndClass[0], nil);
ShowWindow(WndHandle, SW_RESTORE);
end;


//全屏幕
form1.borderstyle:=bsnone;
setbounds(0,0,screen.width,screen.height);

//启动画面:
program Project1;
uses
Forms,SysUtils,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2};
{$R *.res}
begin
Application.Initialize;
form2:=tform2.Create(application);
form2.Show;
form2.Update;
Application.CreateForm(TForm1, Form1);
application.Initialize;
application.Title:='你好';
sleep(1000);
form2.Close;
Application.Run;
end.

//打开网页
use shellapi;
//只打开一个窗口
ShellExecute(handle, '' , pChar('http://www.csdn.net'), '','', SW_SHOWNORMAL);
//新建一个窗口
ShellExecute(handle,'open','Explorer',pChar('http://www.csdn.net'),nil,SW_SHOW);


//旋转字体
procedure TForm1.Button1Click(Sender: TObject);
var
lf:tlogfont;
tf:tfont;
begin
with form1.Canvas do
begin
font.Name:='黑体';
font.Size:=24;
tf:=tfont.Create;
tf.Assign(font);
getobject(tf.handle,sizeof(lf),@lf);
lf.lfEscapement:=450;
lf.lfOrientation:=450;
tf.handle:=createfontindirect(lf);
font.assign(tf);
tf.Free;
textout(20,height div 2,'你好');
end;
end;



//平铺图片
procedure TForm1.FormCreate(Sender: TObject);
begin
bitmap:=tbitmap.Create;
bitmap.LoadFromFile('ppmm.bmp');
end;
procedure TForm1.FormPaint(Sender: TObject);
var
x,y,w,h:longint;
begin
with bitmap do
begin
w:=width;
h:=height;
end;
y:=0;
while y<height do
begin
x:=0;
while x<width do
begin
canvas.Draw(x,y,bitmap);
inc(x,w);
end;
inc(y,h);
end;
end;


//透明窗体
{
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Brush.Style:=bsclear;
form1.BorderStyle:=bsnone;
end;
procedure tform1.createparams(var params:tcreateparams);
begin
inherited createparams(params);
params.ExStyle:=ws_ex_transparent;
end;
}

//扇动窗体标题栏
{
procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Interval:=getcaretblinktime;
timer1.Enabled:=not timer1.Enabled;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
flashwindow(form1.Handle,true);
end;
}

//窗体拖动
{
private
procedure drag(var M:twmnchittest);
message wm_nchittest;
procedure tform1.drag(var M:twmnchittest);
begin
inherited;
if m.Result=htclient then
m.result :=htcaption;
end;
}

//回车代替tab
{
form1.keypress:=true;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
if not (activecontrol is tdbgrid) then
begin
key:=#0;
perform(wm_nextdlgctl,0,0);
end else
if (activecontrol is tdbgrid ) then
begin
with tdbgrid(activecontrol) do
if selectedindex<(fieldcount-1) then
selectedindex:=selectedindex+1
else selectedindex:=0;
end;
end;
}

//多行提示

procedure TForm1.FormCreate(Sender: TObject);
begin
button1.Hint:='aaa'+chr(13)+'bbb'
end;


use mmsystem;
//左右声道
mcisendstring('set all audio on');
//set all audio right off
//set all audio left off
//声量大小
waveoutsetvolume(....

//超级连接效果
procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
label1.Font.Style:=[fsbold,fsunderline];
label1.font.color:=clyellow;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
label1.Font.Style:=[fsbold];
label1.font.color:=clmaroon;
end;


//listbox的水平滚动条
procedure TForm1.FormCreate(Sender: TObject);
VAR
i,maxwidth:integer;
begin
maxwidth:=0;
for i:=0 to listbox1.Items.Count-1 do
if maxwidth<listbox1.Canvas.TextWidth(listbox1.Items.Strings[i]) then
begin
maxwidth:=listbox1.Canvas.TextWidth(listbox1.Items.Strings[i]);
end;
sendmessage(listbox1.Handle,lb_sethorizontalextent,maxwidth+2,0)
end;

//memo的最大/当前行号?
edit1.Text:=inttostr(memo1.Perform(em_linefromchar,$ffff,0));

//任务栏不显示
procedure TForm1.FormCreate(Sender: TObject);
begin
setwindowlong(application.handle,gwl_exstyle,ws_ex_toolwindow);
end;

//墙纸
//设置
procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
s:='ppmm.bmp';
systemparametersinfo(SPI_SETDESKWALLPAPER,0,PCHAR(S),0);
end;
//清除
procedure TForm1.Button2Click(Sender: TObject);
begin
systemparametersinfo(SPI_SETDESKWALLPAPER,0,NIL,0);
end;
}
//combobox显示或隐藏下拉菜单
//显示
procedure TForm1.Button1Click(Sender: TObject);
begin
sendmessage(combobox1.Handle,cb_showdropdown,1,0);
end;
//隐藏
procedure TForm1.Button2Click(Sender: TObject);
begin
sendmessage(combobox1.Handle,cb_showdropdown,0,0);
end;
//判断
procedure TForm1.Button3Click(Sender: TObject);
begin
if getwindowlong(combobox1.Handle,gwl_style)
and cbs_dropdown=cbs_dropdown
then
edit1.text:='a'
else
edit1.text:='b';
end;

//增加系统菜单条
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure registermsg(var msg:tmsg;var handled:boolean);
public
end;
procedure appendtosystemmenu(form:tform;item:string;itemid:word);
//过程
procedure appendtosystemmenu(form:tform;item:string;itemid:word);
var
normalsysmenu,minimizedmenu:hmenu;
aitem:array[0..255] of char;
pitem:pchar;
begin
normalsysmenu:=getsystemmenu(form.handle,false);
minimizedmenu:=getsystemmenu(application.Handle,false);
if item='-' then
begin
appendmenu(normalsysmenu,mf_separator,0,nil);
appendmenu(minimizedmenu,mf_separator,0,nil);
end
else
begin
pitem:=strpcopy(@aitem,item);
appendmenu(normalsysmenu,mf_string,itemid,pitem);
appendmenu(minimizedmenu,mf_string,itemid,pitem);
end;
end;
//增加分隔线
procedure TForm1.Button1Click(Sender: TObject);
begin
appendtosystemmenu(form1,'-',0);
end;
//增加菜单项
procedure TForm1.Button2Click(Sender: TObject);
begin
appendtosystemmenu(form1,'&Ahaha',99);
application.OnMessage:=form1.registermsg;
end;
//菜单项处理
procedure tform1.registermsg(var msg:tmsg;var handled:boolean);
begin
if msg.message=wm_syscommand then
if msg.wParam=99 then
edit1.text:=edit1.text+'a';
end;

...全文
102 136 打赏 收藏 转发到动态 举报
写回复
用AI写文章
136 条回复
切换为时间正序
请发表友善的回复…
发表回复
bluebottle 2003-10-03
  • 打赏
  • 举报
回复
解决了N多问题~~谢了~~~
xiaoyuer0851 2003-10-03
  • 打赏
  • 举报
回复
呵呵, 强,俺收藏ing…………
xfpjl 2003-09-24
  • 打赏
  • 举报
回复
up
daniel2008 2003-05-06
  • 打赏
  • 举报
回复
多谢!接分
seawavefj 2003-05-06
  • 打赏
  • 举报
回复

接分
xiaozhanger 2003-05-03
  • 打赏
  • 举报
回复
谢谢!接分!
xinghai09 2003-05-03
  • 打赏
  • 举报
回复
好玩,接分。
PKS 2003-04-30
  • 打赏
  • 举报
回复
另存为...
二手夏利 2003-04-30
  • 打赏
  • 举报
回复
请,收藏ing
dht2003 2003-04-30
  • 打赏
  • 举报
回复
接分!
tomboy0 2003-04-30
  • 打赏
  • 举报
回复
up
gexiaohua0626 2003-04-30
  • 打赏
  • 举报
回复
接分!
xubeibei11 2003-04-30
  • 打赏
  • 举报
回复
up
俗人1979 2003-04-30
  • 打赏
  • 举报
回复
收藏
xiaoyuer0851 2003-04-30
  • 打赏
  • 举报
回复
谢谢!~~~

支持
noil0125 2003-04-30
  • 打赏
  • 举报
回复
谢谢!
ming911 2003-04-30
  • 打赏
  • 举报
回复
up
dreamonce 2003-04-30
  • 打赏
  • 举报
回复
good
whose 2003-04-30
  • 打赏
  • 举报
回复
接分快乐!!!
binshan 2003-04-30
  • 打赏
  • 举报
回复
有事没事尽接分
加载更多回复(116)

5,379

社区成员

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

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