?? checkdoc.pas
字號:
unit CheckDoc;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DsgnIntf;
type
TMode = (moCPF, moCGC);
TCheckDoc = class(TComponent)
private
FAbout : string;
FInput : string;
FResult : Boolean;
FMode : TMode;
procedure SetInput(Value: string);
procedure SetMode(Value: TMode);
procedure SetCPF(Value: string);
procedure SetCGC(Value: string);
procedure SetResult(Value: boolean);
procedure ShowAbout;
protected
public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property About : string read FAbout write FAbout stored False;
property Input : string read FInput write SetInput;
property Mode : TMode read FMode write SetMode;
property Result : boolean read FResult write SetResult;
end;
procedure Register;
implementation
{#######################################################################}
type
TAboutProperty = class(TPropertyEditor)
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue : string; override;
end;
procedure TAboutProperty.Edit;
{Invoke the about dialog when clicking on ... in the Object Inspector}
begin
TCheckDoc(GetComponent(0)).ShowAbout;
end;
function TAboutProperty.GetAttributes: TPropertyAttributes;
{Make settings for just displaying a string in the ABOUT property in the
Object Inspector}
begin
GetAttributes := [paDialog, paReadOnly];
end;
function TAboutProperty.GetValue: String;
{Text in the Object Inspector for the ABOUT property}
begin
GetValue := '(About)';
end;
procedure TCheckDoc.ShowAbout;
var
msg: string;
const
carriage_return = chr(13);
begin
msg := 'CheckDoc v1.0';
AppendStr(msg, carriage_return);
AppendStr(msg, 'A freeware component');
AppendStr(msg, carriage_return);
AppendStr(msg, carriage_return);
AppendStr(msg, 'by Roger Constantin Demetrescu');
AppendStr(msg, carriage_return);
AppendStr(msg, carriage_return);
AppendStr(msg, 'rogercd@iconet.com.br');
ShowMessage(msg);
end;
{#######################################################################}
constructor TCheckDoc.Create( Aowner: Tcomponent);
begin
inherited Create( Aowner );
FInput := '';
FResult := False;
FMode := moCPF;
end;
destructor TCheckDoc.Destroy;
begin
inherited Destroy;
end;
procedure TCheckDoc.SetMode(Value: TMode);
begin
if FMode <> Value then
begin
FMode := Value;
SetInput(FInput);
end;
end;
procedure TCheckDoc.SetInput(Value: string);
begin
FInput := Value;
case FMode of
moCPF: SetCPF(Value);
moCGC: SetCGC(Value);
end;
end;
procedure TCheckDoc.SetCPF(Value: string);
var
localCPF : string;
localResult : boolean;
digit1, digit2 : integer;
ii,soma : integer;
begin
localCPF := '';
localResult := False;
{analisa CPF no formato 999.999.999-00}
if Length(FInput) = 14 then
if (Copy(FInput,4,1)+Copy(FInput,8,1)+Copy(FInput,12,1) = '..-') then
begin
localCPF := Copy(FInput,1,3) + Copy(FInput,5,3) + Copy(FInput,9,3) +
Copy(FInput,13,2);
localResult := True;
end;
{analisa CPF no formato 99999999900}
if Length(FInput) = 11 then
begin
localCPF := FInput;
localResult := True;
end;
{comeca a verificacao do digito}
if localResult then
try
{1
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -