孤独的猫

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

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 孤独的猫 阅读(196) 评论(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 孤独的猫 阅读(195) 评论(0) 推荐(0) 编辑

摘要: 注: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 孤独的猫 阅读(275) 评论(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 孤独的猫 阅读(294) 评论(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 孤独的猫 阅读(179) 评论(0) 推荐(0) 编辑

摘要: 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 孤独的猫 阅读(243) 评论(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 孤独的猫 阅读(1015) 评论(0) 推荐(0) 编辑

摘要: 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 孤独的猫 阅读(306) 评论(0) 推荐(0) 编辑

摘要: 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 孤独的猫 阅读(269) 评论(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 孤独的猫 阅读(304) 评论(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 孤独的猫 阅读(233) 评论(0) 推荐(0) 编辑

摘要: 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 孤独的猫 阅读(187) 评论(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 孤独的猫 阅读(204) 评论(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 孤独的猫 阅读(163) 评论(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 孤独的猫 阅读(199) 评论(0) 推荐(0) 编辑

摘要: procedure ReplaceStrToStrings(AStrings:TStrings;sToken,sRep:string);vari,j:integer;beginfor i:=0 to AStrings.count-1 dobegins:=AStrings[i];j:=Pos(sToken,s);if (j>0) thenbegins:=Copy(s,1,j-1)+sRep+Copy(s,j+length(sToken),length(s)-(j+length(sToken)));AStrings[i] :=s;end;end;end; 阅读全文
posted @ 2008-09-10 18:39 孤独的猫 阅读(207) 评论(0) 推荐(0) 编辑

摘要: procedure DeleteFiles(Handle:THandle;Source:string);varFO:TShFileOpStruct;beginFillChar(FO,Sizeof(FO),#0);FO.wnd:=handle;FO.wFunc :=FO_Delete;FO.flags:=FOF_NOCONFINFORMATION;FO.pFrom :=PChar(Source);SHFileOperation(FO);end;end; 阅读全文
posted @ 2008-09-10 18:38 孤独的猫 阅读(153) 评论(0) 推荐(0) 编辑

摘要: procedure MoveFile(Handle:THandle;Source,Dest:string);varFO:TShFileOpStruct;beginFillChar(FO,Sizeof(FO),#0);FO.wnd :=Handle;FO.wFunc :=FO_Move;FO.flags :=FOF_NoCONFIFMATION;FO.pFrom :=pchar(Source+#0#0);PO.pTo :=pchar(Dest+#0#0);ShFileOperation(FO);end; 阅读全文
posted @ 2008-09-10 18:36 孤独的猫 阅读(110) 评论(0) 推荐(0) 编辑

摘要: //分解文件夹 SDir:源目录名 DDir:目的目录名 SQZ:生成的子目录(前)后缀名//SExt:文件类型 MNum:每个文件夹的文件数目 B:SQZ为前缀还是后缀名procedure CutDir(SDir,DDir,SQZ,SExt:string;MNum:integer;B:Boolean;handle:THandle);vari,iFileCount,iFileNum,iDirCount,iDirNum:integer;tsr:TStringList;DFileName,SFileName:string;bSearch:Boolean;beginbSearch:=False;ts 阅读全文
posted @ 2008-09-10 18:35 孤独的猫 阅读(275) 评论(0) 推荐(0) 编辑

摘要: function SaveHTMLToStream(Astream:TStream):HResult;varIpStream:IpersistStreamInit;beginwith WebBrower2 dobeginwhile ReadState<>READYSTATE_COMPLETE doForms.Application.ProcessMessages;if Assigned(Document) thenbeginIpStream :=Document as IPersistStreamInit;Result :=IpStream.Save(TStreamAdapter. 阅读全文
posted @ 2008-09-10 17:53 孤独的猫 阅读(224) 评论(0) 推荐(0) 编辑