commonfunclib.pas.svn-base

这个是个简单的关于出票申请的处理

{ *********************************************************************** }
{                                                                         }
{   公共函数单元                                                    }
{                                                                         }
{   设计：                                                                }
{   备注：                                                                }
{   审核：                                                                }
{                                                                         }
{                                                                         }

unit CommonFuncLib;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, ShellAPI, Variants, Tlhelp32,
  Shlobj, ActiveX, MapI, ComObj, StdCtrls, Controls;

const
  defDoubleEpsilon      = 1E-9;
  GLOBALYLTICKETCOUNT = 200;
  COMPANYAGENTID = 555555;

function  IsAlpha(ch: Char): Boolean; overload;
function  IsAlpha(const s: string): Boolean; overload;
function  IsDigit(ch: Char): Boolean; overload;
function  IsDigit(const s: string): Boolean; overload;
function  IsInteger(const s: string): Boolean;
function  IsNumeric(const s: string): Boolean;
function  GoldenInputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
function  GoldenInputBox(const ACaption, APrompt, ADefault: string): string;

implementation

uses
  StrUtils, ZLib, Math, Forms;

function InterMessageBox(const AText, ACaption: string;
  AStyle: Integer): Integer;
begin
  Result := Application.MessageBox(Pchar(AText), Pchar(ACaption), AStyle);
{
  nHwnd := GetActiveWindow;
  Result := Windows.MessageBox(nHwnd, Pchar(AText), Pchar(ACaption), AStyle);
}
end;

function IsAlpha(ch: Char): Boolean;
begin
  Result := ch in ['A'..'Z', 'a'..'z'];
end;

function IsAlpha(const s: string): Boolean;
begin
  if Length(s) = 0 then
    Result := False
  else
    Result := IsAlpha(s[1]);
end;

function IsDigit(ch: Char): Boolean;
begin
  Result := ch in ['0'..'9'];
end;

function IsDigit(const s: string): Boolean;
begin
  if Length(s) = 0 then
    Result := False
  else
    Result := IsDigit(s[1]);
end;

{$HINTS OFF}
function IsNumeric(const s: string): Boolean;
var
  strExpress: string;
  eValue: Extended;
begin
  try
    strExpress := Trim(s);
    if SameText('', strExpress) then
      Result := False
    else Result := TextToFloat(PChar(strExpress), eValue, fvExtended);
  except
    Result := False;
  end;
end;
{$HINTS ON}

{$HINTS OFF}
function IsInteger(const s: string): Boolean;
var
  strExpress: string;
  I, E: Integer;
begin
  try
    strExpress := Trim(s);
    if SameText('', strExpress) then
      Result := False
    else begin
      Val(strExpress, I, E);
      Result := E = 0;
    end;
  except
    Result := False;
  end;
end;
{$HINTS ON}


function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do
    Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do
    Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    Result.X := Result.X div 52;
end;

function  GoldenInputQuery(const ACaption, APrompt: string; var Value: string): Boolean;
var
  Form:   TForm;
  Prompt:   TLabel;
  Edit:   TEdit;
  DialogUnits:   TPoint;
  ButtonTop, ButtonWidth, ButtonHeight:   Integer;
begin
  Result := False;
  Form := TForm.Create(Application);
  with Form do
  try
    Canvas.Font := Font;
    DialogUnits :=  GetAveCharSize(Canvas);
    BorderStyle := bsDialog;
    Caption := ACaption;
    ClientWidth := MulDiv(180, DialogUnits.X, 4);
    ClientHeight := MulDiv(63, DialogUnits.Y, 8);
    Position := poScreenCenter;

    Prompt := TLabel.Create(Form);
    with Prompt do
    begin
      Parent := Form;
      Font.Name := 'Times New Roman';
      Font.Size := 9;
      layout := tlCenter;
      AutoSize := False;
      Left := MulDiv(8, DialogUnits.X, 4);
      Top := 0;
      Width := Muldiv(180-2*8, DialogUnits.X, 4);
      Height := Muldiv(18,DialogUnits.Y, 8);
      WordWrap := True;
      Caption := APrompt;
    end;

    Edit := TEdit.Create(Form);
    with Edit do
    begin
      Parent := Form;
      Left := Prompt.Left;
      Top := MulDiv(19, DialogUnits.Y, 8);
      Width := MulDiv(164, DialogUnits.X, 4);
      MaxLength := 255;
      Text := Value;
      SelectAll;
    end;

    ButtonTop := MulDiv(41, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(50, DialogUnits.X, 4);
    ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
    with TButton.Create(Form) do
    begin
      Parent := Form;
      Font.Name := 'Times New Roman';
      Font.Size := 9;
      Caption := '确认';
      ModalResult := mrOk;
      Default := True;
      SetBounds(MulDiv(38, DialogUnits.X,   4), ButtonTop, ButtonWidth,
            ButtonHeight);
    end;

    with TButton.Create(Form) do
    begin
      Parent := Form;
      Font.Name := 'Times New Roman';
      Font.Size := 9;
      Caption   :=   '取消';
      ModalResult := mrCancel;
      Cancel := True;
      SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth,
            ButtonHeight);
    end;

    if ShowModal = mrOk then
    begin
      Value := Edit.Text;
      Result := True;
    end;
  finally
    Form.Free;
  end;
end;

function GoldenInputBox(const ACaption, APrompt, ADefault: string): string;
begin
  Result := ADefault;
  GoldenInputQuery(ACaption, APrompt, Result);
end;

end.