应部分网友要求,公开 myfunctions 单元,里面有很多有用的函数
unit myFunctions;
//---------- 说明--------------
// by 冯思锐 最后修改2010-11-23
// QQ: fengsirui@sina
// 部分代码来自互联网,大部分为自己所写
// 博客:blog.sina/fsr2009
// 有一个函数 DrawChorkSoft(背景水印)需要引用cnGraphics,cnPack里面的一个单元,开源的可以在网上下载。
interface
uses Windows, SysUtils, Graphics, StrUtils, Classes, DateUtils, Dialogs,
Controls, forms, messages, Registry, stdCtrls, ExtCtrls, Buttons,
Variants, TypInfo, ComCtrls, wininet, WinSock, shellApi, ComObj,ActiveX,
imgList, shlObj, cnGraphics, Menus, commCtrl, mmSystem;
Const
C1 = 52845;
C2 = 22719;
CM_CLOSEUP = WM_USER+0;
CM_FLASHWINDOW = WM_USER+1;
DEFAULT_DELIMITERS = ['^', #9, #10, #13];
CS_SHADOW = $00020000;
CM_VALIDATE = WM_USER+1;
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
TTM_WINDOWFROMPOINT = WM_USER + 16;
ICC_WIN95_CLASSES = $000000FF;
CCH_MAXNAME=255;
LNK_RUN_MIN=7;
LNK_RUN_MAX=3;
LNK_RUN_NORMAL=1;
type
TShapeStyle = (shsLeft, shsTop, shsRight, shsBottom);
TFindCallBack = procedure (const filename:string;const info:TSearchRec; var bQuit, bSub: boolean) of object;
TShapeStyles = set of TShapeStyle;
TpointPos = (ppTopCenter, ppBottomCenter, ppCenter);
LINK_FILE_INFO = record
FileName: array[0..MAX_PATH] of char;
WorkDirectory: array[0..MAX_PATH] of char;
IconLocation: array[0..MAX_PATH] of char;
IconIndex:integer;
Arguments: array[0..MAX_PATH] of char;
Description: array[0..CCH_MAXNAME] of char;
ItemIDList: PItemIDList;
RelativePath: array[0..255] of char;
ShowState: integer;
HotKey:
word;
end;
TGradDir = (gdLeftRight, gdTopBottom);
TLinePos = (lnLeft, lnTop, lnRight, lnBottom);
TMyWriter = class(TWriter)
public
procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
end;
TMyReader = class(TReader)
public
procedure ReadProperty(Instance: TPersistent);
end;
function getAlphaColor(BackColor,ForeColor: TColor; alpha: integer): TColor;
function DarkColor(const Color: TColorRef; const Percent: Byte): TColorRef;
procedure GrayDrawimage(AImages: TCustomImageList; ACanvas: TCanvas;
Index, x, y: Integer; TransColor: TColor);
function RandomChar(str: string): char;
function indexofName(name: string; AR: array of string): integer;
function Confirm(Msg: string): Boolean;
function GetPopupRect(P: TPoint; R: TRect; H: Integer): TRect;
procedure RLalignDraw(R: Trect; Cvs: TCanvas; s : WideString);
procedure blendColor(ACanvas: TCanvas; ARect: TRect; FColor: TColor; Value: byte) overload;
procedure BlendCanvas(BCanvas,FCanvas: TCanvas; FRect: TRect;
Sx,Sy: integer; Value: byte);
procedure BlendBmp(bmp: TBitmap; clBlend: Tcolor; value: byte);
procedure blendDrawBmp(SCanvas: TCanvas; bmp: Tbitmap; Ax,Ay: integer;
TransColor: TColor; BValue: byte); overload;
procedure blendDrawBmp(SCanvas: TCanvas; bmp: Tbitmap; Ax,Ay: integer;
BValue: byte); overload;
procedure delay(times: integer);
function MouseIORect(R: TRect; pt: TPoint; var R1, R2: boolean): boolean;
procedure drawCheckMark(cvs: TCanvas; R: TRect; width: integer; color: TColor);
procedure di