Delphi笔记[五] | Kyle's Blog

if (Key=VK_F4)and(ssAlt in shift) then {使系统键Alt+F4失效}

控件Transparent属性值为True时，背景是透明的

bsTrayIcon1控件，在OnDbClick事件中写form1.show就可以达到效果，但是要将SkinForm这个控件中的TrayIcon属性与之相关联
RxGIFAnimator控件，可以放GIF图片
RxDice赊子控件，可以放一个赊子，Rotate属性表示是否变化
RxClock控件，显示系统时间
ColorComboBox,用来选择Color用的一个ComboBox
FontComboBox，用来选择字体
RxCalcEdit,带有计算功能的一个Edit
DirectoryEdit，用来选择目录的一个Edit
DateEdit,用来选择Date的一个Edit
FilenameEdit，用来选择File的一个Edit
ClipboardViewer，用来显示系统剪切板里面的东西
RxLoginDialog,一个密码确认的，其中要在OnCheckUser事件时面写上用户名和密码是否正确的代码

Cookies相关操作：

idhtp1.CookieManager := TIdCookieManager.Create(nil);
idhtp1.CookieManager.AddCookie(‘baidu=sb’,'baidu.com’);
idhtp1.Get(‘http://www.baidu.com’);
for I := 0 to idhtp1.CookieManager.CookieCollection.Count – 1 do
s := s + idhtp1.CookieManager.CookieCollection.Items[i].CookieText;
ShowMessage(s);

procedure TForm1.Timer1Timer(Sender: TObject);
var
SList: TStrings;
i: integer;
begin
   Doc := WebBrowser1.Document as IHTMLDocument2;
   if edit2.Text = ” then Exit;
   SList := TStringList.Create; {修改浏览器的Cookies}
   Slist.CommaText := edit2.Text;
   for i := 0 to SList.Count – 1 do {将Cookies分段提交给浏览器}
   Doc.cookie := SList.Strings[i];
   SList.Free; {释放}
end;

使程序最大化的代码：

Form1.WindowState:=WSMaximized;
type TWindowState = (wsNormal, wsMinimized, wsMaximized);

var
MyStream:TMemoryStream;
begin
MyStream:=TMemoryStream.Create;
IdHTTP1.Get(‘http://www.138soft.com/download/Mp3ToExe.zip’,MyStream);//下载站点的一个ZIP文件

*取得与网址有关的Cookie
用InternetGetCookie这个API,它在WinInet单元中
有4个参数,第一个是URL,第二个设为nil,第三个指到一个变量BUFFER,存放Cookie的内容,第四个是Cookie的长度
InternetGetCookie(PChar(Edit1.Text), nil, buf, Size)

*给idHttp设置Cookie
idHttp1.Request.CustomHeaders.Text := ‘Cookie: ‘ + Memo1.Lines.Text;

程序自删除：

procedure TForm1.Button1Click(Sender: TObject);
var Selfname,BatFilename,s1,s2:string;
BatchFile: TextFile;
begin
Selfname:=Extractfilename(application.exename);//取EXE文件自己的名称
BatFilename:=ExtractFilePath(Application.ExeName)+ ‘a.bat’;//批处理文件名称
S1:=’@del ‘+Selfname;
S2:=’if exist ‘+Selfname+’ goto pp’;
assignfile(BatchFile,BatFilename);
rewrite(BatchFile);
writeln(BatchFile,’:pp’);
writeln(BatchFile,S1);
writeln(BatchFile,S2);
writeln(BatchFile,’@del %0′);
closefile(BatchFile);
winexec(pchar(BatFilename),sw_hide);//隐藏窗口运行a.bat
application.Terminate;//退出程序
end;

创建文件夹可用API函数CreateDirectory(PChar(ExtractFilePath(ParamStr(0))+’Test’),nil);
也可用CreateDir,CreateDir(‘d:\abc’);

TspSkinButton里面有SkinDataName可以选择Button的类型

TextLabel控件可以输入多行，而Label只能输入一行文字

handle2:=FindWindowEx(handle1,0,’Button’,’开启’);这样找窗体内的按钮句柄是找不到的，这个好像只能找窗体的子窗口的按钮的句柄
找窗体上按钮用EnumChildWindows，如：

EnumChildWindows(handle1,@DoIt,0);   其中handle1是我们找好了的父句柄,DoIt是一个回调函数如下：
function DoIt(h:THandle;i:integer):Boolean;stdcall;
var s:array[0..255] of char;
begin
   result:=true; //不可少，否则可能只执行一次
   GetWindowText(h,pchar(@s),255);
   showmessage(string(s));
   if strpas(s)=’开启’ then   //StrPas函数将以NULL结束的字符串转换为PASCAL类的字符串，这里必须用StrPas
   begin
    PostMessage(h,WM_LBUTTONDOWN,0,0);
    PostMessage(h,WM_LBUTTONUP,0,0);
   end;
end;         //获取关于这个按钮的句柄并模拟鼠标点击

GetWindow(),FindWindow(),FindWindowEx(),EnumWindows(),EnumChildWindows()…都是用来获得窗口句柄的，获得句柄标题的函数是GetWindowText()

SendMessage(TreeView.Handle,TVM_SETBKCOLOR,0,RGB(255,0,0));　设置TV背景颜色
SendMessage(Button.Handle,WM_LBUTTONDOWN,0,0);　　鼠标左键按下
SendMessage(Button.Handle,WM_LBUTTONUP,0,0);　　　鼠标左键抬起
SendMessage(Edit.Handle,WM_SETTEXT,255,Integer(PChar(‘abc’)));　传递文本
SendMessage(Edit.Handle,WM_Char,Wparam(‘Q’),2);　　传递字符
SendMessage(Button.Handle,BM_SETSTYLE,BS_RADIOBUTTON,1);　　改变Button风格
SendMessage(ComboBox.Handle,CB_SETDROPPEDWIDTH,300,0);　　改变CBDownWidth
WM_CUT、WM_COPY和WM_PASTE　　剪切，复制，粘帖

实现任意组合键

keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), 0, 0);
keybd_event(ord(‘V’), MapVirtualKey(ord(‘V’), 0), 0, 0);
keybd_event(ord(‘V’), MapVirtualKey(ord(‘V’), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_Control, MapVirtualKey(VK_Control, 0), KEYEVENTF_KEYUP, 0);

BitBlt(Image.Canvas.Handle,0,0,Image1.Width,Image1.Height,GetDC(GetForegroundWindow),0,0,SRCCOPY);截当前窗口的屏

设置窗口的BorderStyle属性禁止改变窗体大小比如设成bsSingle等等

BOOL GetWindowRect(
HWND hWnd,      // handle to window
LPRECT lpRect   // address of structure for window coordinates
);

//捕捉全屏幕图像并保存到: c:\temp\Screen.bmp
procedure TForm1.Button1Click(Sender: TObject);
var
bit: TBitmap;
cvs: TCanvas;
begin
bit := TBitmap.Create;
bit.SetSize(Screen.Width, Screen.Height);

cvs := TCanvas.Create;
cvs.Handle := GetDC(0);

bit.Canvas.CopyRect(Screen.DesktopRect, cvs, Screen.DesktopRect);
bit.SaveToFile(‘c:\temp\Screen.bmp’);

cvs.Free;
bit.Free;
end;

//把文字输出到屏幕
procedure TForm1.Button1Click(Sender: TObject);
var
cvs: TCanvas;
Rect: TRect;
Str: string;
begin
cvs := TCanvas.Create;
cvs.Handle := GetDC(0);
SetBkMode(cvs.Handle, TRANSPARENT);
//cvs.Font.Name := ‘宋体’;
cvs.Font.Style := [fsBold, fsItalic];
cvs.Font.Size := 48;
Randomize;
cvs.Font.Color := Random($FFFFFF);
Rect := Screen.DesktopRect;
Str := ‘龙在天博客’;
cvs.TextRect(Rect, Str, [tfSingleLine, tfCenter, tfVerticalCenter]);
cvs.Free;
end;

把整个窗体保存为图片的方法:

procedure TForm1.Button1Click(Sender: TObject);
var
bit: TBitmap;
begin
bit := TBitmap.Create;
bit.Width := Width;
bit.Height := Height;
BitBlt(bit.Canvas.Handle, 0, 0, Width, Height, GetWindowDC(Handle), 0, 0, SRCCOPY);
bit.SaveToFile(‘c:\temp\Form1.bmp’);
bit.Free;
end;

trunc()取整
round()四舍五入

HANDLE GetCurrentProcess(VOID) 返回当前进程的句柄(系统),无参数
如果PostMessage(GetCurrentProcess(),WM_CLOSE,0,0); 则系统将强制关闭

PostMessage(hWnd,WM_SYSKEYDOWN,0×41,1<<29);
经过测试，发现这个就是Alt+A的效果

RadioGroup1.Items.CommaText := ‘Left,Center,Right’;//就直接加了三个按钮并赋了值

设置Edit中字的对齐方式：SetWindowLong(Edit1.Handle, GWL_STYLE, 2);右对齐

procedure TForm1.RadioGroup1Click(Sender: TObject);
var
es: Integer;
begin
es := GetWindowLong(Edit1.Handle, GWL_STYLE) or 3;
es := es xor (3 – RadioGroup1.ItemIndex);
SetWindowLong(Edit1.Handle, GWL_STYLE, es);
Edit1.Refresh;
end;

决定对齐方式的三个常量值 ES_LEFT、ES_CENTER、ES_RIGHT 分别是 0、1、2

if GetKeyState(VK_SHIFT) < 0 then Memo1.Lines.Add(‘Shift’);
if GetKeyState(VK_LSHIFT) < 0 then Memo1.Lines.Add(‘LeftShift’);
if GetKeyState(VK_RSHIFT) < 0 then Memo1.Lines.Add(‘RightShift’);
if GetKeyState(VK_CONTROL) < 0 then Memo1.Lines.Add(‘Ctrl’);
if GetKeyState(VK_LCONTROL) < 0 then Memo1.Lines.Add(‘LeftCtrl’);
if GetKeyState(VK_RCONTROL) < 0 then Memo1.Lines.Add(‘RightCtrl’);
if GetKeyState(VK_MENU) < 0 then Memo1.Lines.Add(‘Alt’);
if GetKeyState(VK_LMENU) < 0 then Memo1.Lines.Add(‘LeftAlt’);
if GetKeyState(VK_RMENU) < 0 then Memo1.Lines.Add(‘RightAlt’);

工具条按钮上的下拉菜单:

ToolButton1.Style := tbsDropDown;
ToolButton2.Style := tbsDropDown;
ToolButton1.DropdownMenu := PopupMenu1;
ToolButton2.DropdownMenu := PopupMenu2;

制作任意拖动窗体：

procedure Form1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(self.Handle, WM_SYSCOMMAND,SC_MOVE+HTCAPTION, 0);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;

从资源文件中装载鼠标：

var MyCursor:HCURSOR;
MyCursor:=LoadCursor(hInstance,’NEWCURSOR’);

ParamCount返回命令行的总数,ParamStr(2)显示第2条命令,ParamStr(0)返回本地路径

这种方法的原理是程序运行时先查看自己是不是在特定目录下,如果是就继续运行,如

果不是就把自己拷贝到特定目录下,然后运行新程序,再退出旧程序.
打开Delphi,新建一个工程,在窗口的Create事件中写代码:

procedure TForm1.FormCreate(Sender: TObject);
var myname: string;
begin
myname := ExtractFilename(Application.Exename); //获得文件名
if application.Exename <> GetWindir + myname then //如果文件不是在Windows\System\那么..
begin
copyfile(pchar(application.Exename), pchar(GetWindir + myname), False);{将自己拷贝到Windows\System\下}
Winexec(pchar(GetWindir + myname), sw_hide);//运行Windows\System\下的新文件
application.Terminate;//退出
end;
end;

其中GetWinDir是自定义函数,其功能是找出Windows\System\的路径.

function GetWinDir: String;
var
Buf: array[0..MAX_PATH] of char;
begin
GetSystemDirectory(Buf, MAX_PATH);
Result := Buf;
if Result[Length(Result)]<>’\’ then Result := Result + ‘\’;
end;

sendmessage(hwnd_broadcast,wm_syscommand,sc_screensave,0); //快速启动屏保

//得到临时文件夹
function Temppath: string;
var tmpdir: array[0..255] of char;
begin
GetTempPath(255, @tmpdir);
Result := StrPas(Tmpdir);
end;

//==============================查找句柄套装=======================
EnumChildWindows(idid2,@DoIt,0);
function DoIt(h:THandle;i:integer):Boolean;stdcall;
var s:array[0..255] of char;
begin
   result:=true;      //不可少，否则可能只执行一次
   GetWindowText(h,pchar(@s),255);
   if pos(‘是’,strpas(s))<>0 then
   begin
    PostMessage(h,WM_LBUTTONDOWN,0,0);
    PostMessage(h,WM_LBUTTONUP,0,0);
   end;
end;

function LCalCoordinate(A,B:Point;var ab_bear:single):single;//顺便返回 ab_bear 必须使用var才能返回ab_bear

PageControl进行排序可在对象检查器里面拖动相应的Page就可以了.

bsSkinTextLabel里面的字体颜色设置，要不使用SkinData才能体现出来.

XPManifest控件可使按钮成XP系统样式，在WIN32面板中

Image1.Picture.Bitmap.Handle := LoadBitmap(HInstance, ‘bmp1′);
image1.Picture.Bitmap.LoadFromResourceName(HInstance, ‘bmp2′);

用图片作程序背景：

bit := TBitmap.Create;
bit.LoadFromResourceID(HInstance, 1);
Self.Brush.Bitmap := bit;
Repaint;

其中rc文件中用编号 1 BITMAP img\bmpFile1.bmp