孤独的猫

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
上一页 1 ··· 21 22 23 24 25 26 下一页

2008年9月12日

判断是否安装BDE
摘要： function BDEInstalled:Booleanvarreg:TRegistry;s:string;beginResult :=False;reg :=TRegistry.Create;reg.Rootkey :=HKEY_LOCAL_MACHINE;reg.Openkey('Software\Borland\Database Engine',False);s:='';trys:=reg.ReadString('CONFIGFILE01');if s<>'' thenResult :=True;finally 阅读全文
posted @ 2008-09-12 21:40 孤独的猫 阅读(223) 评论(0) 推荐(0)

判断系统的启动模式
摘要： procedure TForm1.Buuton1Click(Sender:TObject);begincase (GetSystemMetrix(SM_CLEANBOOT)) of0: Showmessage('正常模式启动');1: Showmessage('安全模式启动');2: Showmessage('正常模式启动,但附带网络功能')elseApplication.MessageBox('错误，系统启动有问题','警告',MB_ICONWARNING);end;end; 阅读全文
posted @ 2008-09-12 21:32 孤独的猫 阅读(288) 评论(0) 推荐(0)

随机产生一个中文
摘要： functionRandomizw:string;varok:array[0..2] of byte;sp:char;beginok[0] :=random(72)+176;ok[1] :=random(94)+161;ok[2] :=0;sp :=@ok;Result :=string(sp);end; 阅读全文
posted @ 2008-09-12 21:30 孤独的猫 阅读(206) 评论(0) 推荐(0)

提取文件的属性对话框(显示属性页)
摘要： varsei:TSHELLEXECUTEINFO;beginZeroMemory(@sei,sizeof(sei))sei.cbSize :=Sizeof(sei);sei.lpFile :=''C:\1.txt';sei.lpVerb :='properties';sei.fMask :=SEE_MASK_INVOKEIDLIST;ShellExecuteEx(@sei);end; 阅读全文
posted @ 2008-09-12 21:25 孤独的猫 阅读(277) 评论(0) 推荐(0)

获取浏览器的当前页面地址
摘要： function URLInfo(sBrowserPrgFile,sServiceName:string;NetScape:boolean;var Title:string):pchar;varDdeClientConv:TDDEClientConv;StartPtr,EndPtr:pchar;browseWinName:string;{参数说明}{sBrowserPrgFile:浏览器EXE文件的完整路径名sServiceName:浏览器的DDE-Service名字,如Netscape是Netscape,IE是'iexplore' Title:返回当前网页的Title 返回值 阅读全文
posted @ 2008-09-12 21:12 孤独的猫 阅读(855) 评论(0) 推荐(0)

控制控制台
摘要： vars:string;beginAllocConsole;tryWrite('Type here your words and press Enter');Readln(s);ShowMessage(Format('You typed: "%s"',[s]));finallyFreeConsole;end;end; 阅读全文
posted @ 2008-09-12 21:07 孤独的猫 阅读(173) 评论(0) 推荐(0)

判断文件是否在使用
摘要： function IsFileInUse(fName:string):Boolean;varHFileRes:HFile;beginResult :=False;if not FileExists(fname) then exit;HFileRes :=CreateFile(pchar(fName),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);Result :=(HFileRes=INVALID_HANDLE_VALUE);if not Result thenCloseHandle(HFi 阅读全文
posted @ 2008-09-12 21:03 孤独的猫 阅读(258) 评论(0) 推荐(0)

Windows系统自启动程序九大藏身之所
摘要： 在＂开始＂菜单的＂程序＂中的＂启动＂下Load注册键，位置　HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows\LoadUserinit注册键，位置　HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\WinLogon\userinit 这个键允许同时指定多个启动程序，中间用＂,＂分开，如＂userinit.exe OSA.exe＂Explorer\Run注册键Explorer\Run注册键在HKEY_CURRENT_USER和H 阅读全文
posted @ 2008-09-12 20:31 孤独的猫 阅读(231) 评论(0) 推荐(0)

在窗体边框上画图
摘要： 1.在private定义消息函数 procedure WMNCPaint(var Msg:TWMNCPaint);message WM_NCPaint;2.WMNCPaint函数为procedure TForm1.WMNCPaint(var Msg:TWMNCPaint);vardc:hDc;Pen:hPen;OldPen:hPen;OldBrush:hBrush;begininherited;dc :=GetWindowDC(handle);Pen :=CreatePen(PS_SOLID,1,RGB(255,0,0));OldPen :=SelectObject(dc,Pen);OldBr 阅读全文
posted @ 2008-09-12 20:25 孤独的猫 阅读(202) 评论(0) 推荐(0)

2008年9月11日

Delphi编写星光效果
摘要： 一 窗体设计object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 397 ClientWidth = 530 Color = clNone Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate OnDestroy = F 阅读全文
posted @ 2008-09-11 20:45 孤独的猫 阅读(309) 评论(0) 推荐(0)

网格动画
摘要： 在窗体上放入以Timer控件，在控件的Timer事件中写入varBrushPt:TPoint;BrushHandl,OldBrush:HBRUSH;FormDC:HDC;BrushOffset:Integer;beginBrushOffset:=0;FormDC:=GetDC(Form1.Handle);Inc(BrushOffset);BrushHandl:=CreateHatchBrush(HS_DIAGCROSS,clRed);SetBrushOrgEx(FormDC,BrushOffset,BrushOffset,nil);//设置画刷为网格形式OldBrush:=Select Obj 阅读全文
posted @ 2008-09-11 13:46 孤独的猫 阅读(202) 评论(0) 推荐(0)

在TForm中应用OpenGL
摘要： 一 新建一工程，设保存为OpenGLApp.dpr,窗口为Form1二 在Form1中加入Panel1和Button1,unit1.pas代码为unit Unit1;interfaceusesWindows,messages,Sysutils,classes,graphics,controls,Forms,Dialogs,OpenGL,Exectrs,Stdctrls;typeTForm1=class(TForm)Panel1:TPanel;Button1:TButton;procedure FormCreate(Sender:TObject);procedure PanelResize(Se 阅读全文
posted @ 2008-09-11 13:45 孤独的猫 阅读(254) 评论(0) 推荐(0)

测试PHP
摘要： 为了测试PHP配置是否成功，可用下面的PHP代码测试<?phpphpinfo()?>测试PHP是否能够连接MySQL,可用下面代码测试<?php$link=mysql_connect('localhost','root','123456');if (!$link) echo "失败！";else echo "成功！";mysql_close();?> 阅读全文
posted @ 2008-09-11 13:44 孤独的猫 阅读(149) 评论(0) 推荐(0)

利用PHPLIB加入模板功能
摘要： 首先在PHP根目录中输入以下代码，并存为mytempate1.php<?phpinclude "template.inc";$my_color="blue";//将在后面使用$t=new template("E:\\Myphp\\templates");$t->set_file("myfileHandle","mytemplate1.ihtml");//设置myfileHandle=我们的模板$t->set_var("some_color",$my_colo 阅读全文
posted @ 2008-09-11 13:42 孤独的猫 阅读(174) 评论(0) 推荐(0)

让Apache支持ruby写的cgi程序
摘要： ruby apache cgi 配置 1，按说明安装ruby的apache mod2，配置文件如下：Code highlighting produced by Actipro CodeHighlighter (freeware)http://www.CodeHighlighter.com/--> 1 ######################################################### 2 # ruby cgi 配置 3 ######################################################### 4 LoadModule 阅读全文
posted @ 2008-09-11 13:41 孤独的猫 阅读(344) 评论(0) 推荐(0)

2008年9月10日

高斯模糊
摘要： procedure Effect_GaussianBlur(Amount:integer;Picture:TBitmap);var BB:TBitmap;beginBB :=TBitmap.Create;BB.PixelFormat :=pf24bit;BB.Assign(Picture.Bitmap);GaussianBlur(BB,Amount);Picture.Bitmap.Assign(BB);BB.Free;end;procedure GaussianBlur(var clip:TBitmap;Amount:integer);vari:integer;beginfor i:=Amou 阅读全文
posted @ 2008-09-10 21:51 孤独的猫 阅读(207) 评论(0) 推荐(0)

列举串口
摘要： procedure EnumPorts(PortList:TStringList);varMaxPorts:integer;hPort:THandle;PortNumber:integer;PortName:integer;beginif PortList=nil then Exit;case WIN32PlatForm ofVER_PLATFORM_WIN32_NT: MaxPorts:=256;VER_PLATFORM_WIN32_WINDOWS: MaxPorts:=9;end;for PortNumber :=1 to MaxPorts dobeginif PortNumber> 阅读全文
posted @ 2008-09-10 21:50 孤独的猫 阅读(209) 评论(0) 推荐(0)

用TNMFTP上传文件
摘要： 注：TFTP为窗体类名procedure TFTP.Button1Click(Sender:TObject);beginbutton1.Enabled:=false;NMFTP1.Host:='www.wh-ccic.com.cn';NMFTP1.Port :=21;NMFTP1.TimeOut:=5000;NMFTP1.UserID :=UserTxt.Text;NMFTP1.Password :=PassTxt.Text;tryNMFTP1.Connect;exceptExit;end;NMFTP1.InputFileMode:=False;NMFTP1.OutputFil 阅读全文
posted @ 2008-09-10 21:50 孤独的猫 阅读(288) 评论(0) 推荐(0)

获取网页快照
摘要： unit uWebCracker;interfaceuses mshtml,SHdocvw,classes,SysUtils,StrUtils;constMAXPAGECOUNT=20;typeTWebPageRecord=recordURL:string;Title:string;Text:string;end;typeTWebCracker=class(TObject)privateFWebPageRecordArray:array[0..MAXPAGECOUNT-1] of TWebPageRecord;FWebPageCount:integer;publicconstructor Cr 阅读全文
posted @ 2008-09-10 21:49 孤独的猫 阅读(302) 评论(0) 推荐(0)

浮雕效果
摘要： procedure Effect_Emboss(Picture:TBitmap);varBB1,BB2:TBitmap;beginBB1:=TBitmap.Create;BB1.PixelFormat :=pf24bit;BB1.Assign(Picture.Bitmap);BB2:=TBitmap.Create;BB2.PixelFormat:=pf24bit;BB2.Assign(BB1);Emboss(BB2);Picture.Bitmap.Assigned(BB2);BB1.Free;BB2.Free;end;procedure Emboss(var Bmp:TBitmap);varx 阅读全文
posted @ 2008-09-10 21:48 孤独的猫 阅读(197) 评论(0) 推荐(0)

CMOS单元
摘要： unit CMOS;InterfaceconstClockSec = $00; { RTclock seconds }ClockMin = $02; { RTclock minutes }ClockHour = $04; { RTclock hours }ClockDOW = $06; { RTclock day of week }ClockDay = $07; { RTclock day in month }ClockMon = $08; { RTclock month }ClockYear = $09; { RTclock year (mod 100)}AlarmSec = $01; { 阅读全文
posted @ 2008-09-10 21:46 孤独的猫 阅读(256) 评论(0) 推荐(0)

保存的各函数
摘要： unit MySys;interfaceuses Windows, shlObj, Variants, StdCtrls, ComObj, Classes, SysUtils, Controls,Printers, Messages, mmSystem, ComCtrls, UrlMon, winsock, TLhelp32, Registry,Forms, Graphics, IniFiles, ADODB, StrUtils, ExtCtrls, jpeg, ShellAPI, Math,MSHTML,IdStack,OleCtrls, SHDocVw,ActiveX,WinInet;ty 阅读全文
posted @ 2008-09-10 21:46 孤独的猫 阅读(1068) 评论(0) 推荐(0)

algebra单元
摘要： unit algebra;interfaceconst MaxN=30;{You can increase it up to 100,not greaterbut each matrix variable would have size ofsqr(MaxN)*sizeof(Real). It is possible to writeunit for work with dinamically sized matrices,but i have no needs to do this.You can work with matrices with size less that MaxN,but 阅读全文
posted @ 2008-09-10 21:45 孤独的猫 阅读(318) 评论(0) 推荐(0)

HugeUtil(大数)支持单元
摘要： unit HugeUtil;interfaceconst HugeMax = $8000-16;type Huge = recordlen : word;dat : array[1..HugeMax] of word;end;HugePtr = ^Huge;procedure AddHuge (var Answer, Add : Huge);procedure MulHuge (var A : Huge; Mul : integer; var Answer : Huge);procedure DivHuge (var A : Huge; Del : integer; var Answer : 阅读全文
posted @ 2008-09-10 21:44 孤独的猫 阅读(280) 评论(0) 推荐(0)

复数运算单元
摘要： UNIT ComplexOps; { see demo at end }{This UNIT provides complex arithmetic and transcendental functions.(C) Copyright 1990, 1992, Earl F. Glynn, Overland Park, KS. Compuserve 73257,3527.All rights reserved. This program may be freely distributed only fornon-commercial use.Some ideas in this UNIT wer 阅读全文
posted @ 2008-09-10 21:43 孤独的猫 阅读(320) 评论(0) 推荐(0)

插件编写
摘要： 一 编写DLL新建一dpr文件library PDLL;usesSysutils,classes,main in 'main.pas';{$E plg.} //定义后缀名为plgexportsDescribePlugin,InitPlugin;beginend;main.pas为:unit maininterfaceuses Dialogs,Menus,Classes;typeTHolder=classpublicprocedure ClickHandler(Sender:TObject);endprocedure DescribePlugin(var Desc:pchar); 阅读全文
posted @ 2008-09-10 18:55 孤独的猫 阅读(238) 评论(0) 推荐(0)

类似于Split(VB)的函数
摘要： procedure ParseStrToStrings(AStrings:TStrings;S:String;iType:integer;seperator:string);vari:integer;beginif (iType<0) or (iType>5) thenExit;if iType=4 thenbeginAStrings.CommaText :=s;Exit;end;case iType of0: Seperator :=',';1: Seperator :=';';2: Seperator :=' ';3: Seper 阅读全文
posted @ 2008-09-10 18:50 孤独的猫 阅读(202) 评论(0) 推荐(0)

获得指定后缀名的文件数
摘要： function GetFileCount(ThePath,Ext:string):integer;varnum:integer;sr:TSearchRec;beginnum :=0;if ThePath[length(ThePath)]<>'\' thenThePath :=ThePath+'\';if (FindFirst(ThePath+Ext,faAnyFile,sr)=0 thenbeginnum :=num+1;while (FindNext(sr)=0) donum :=num+1;end;result :=num;end;end; 阅读全文
posted @ 2008-09-10 18:47 孤独的猫 阅读(222) 评论(0) 推荐(0)

获得指定文件夹下的子目录数
摘要： function GetDirCount(ThePath:string):integerfunction IsValidDir(SearchRec:TSearchRec):Boolean;beginif (SearchRec.Attr=16) and (SearchRec.Name<>'.') and (SearchRec.Name<>'.'.) thenResult :=TrueelseResult :=False;end;varnum:integer;sr:TSearchRec;beginnum :=0;if (FindFirst(T 阅读全文
posted @ 2008-09-10 18:46 孤独的猫 阅读(172) 评论(0) 推荐(0)

回调函数实例
摘要： 一 编写回调函数代码typeTCallBackFunction=function(s:string):integer;CallMe(s:string):integer;procedure TestCallBack(CllBackFunction:TCallBackFunction);far;external 'Other';function CallMe(s:pchar):integer;beginCallMe :=Length(Strpas(strpas(s)));end;procedure Form1.Button1Click(Sender:TObject);beginTe 阅读全文
posted @ 2008-09-10 18:40 孤独的猫 阅读(208) 评论(0) 推荐(0)

上一页 1 ··· 21 22 23 24 25 26 下一页