簡單問題, 一個通用的打開窗口的函數!

Question

当然可以
如openform(var form:tform);
begin
form:=form.class.create(self);
form.showmodal;
form.free
end;

Answer 1

type 
  TFormClass = class of TForm;function NewInstance(AClass: TClass): Boolean;
begin
  with TFormClass(AClass).Create(Application) do
  try
    Result := ShowModal <> mrOK;
  finally
    Free;
  end;
end;procedure TMainForm.Button1Click()
begin
  NewInstance(TLoginForm.ClassName);
end;procedure TMainForm.Button2Click()
begin
  NewInstance(TSomeForm.ClassName);
end;不知是不是,你试试

Answer 2

function DoForm(mClassForm: TClassForm): Integer;
begin
  with TForm(mClassForm.Create(nil)) do try
    Result := ShowModal;
  finally
    Free;
  end;
end;function DoFormEx(mClassForm: TClassForm; mFormShow, mFormClose: TNotifEvent): Integer;
var
  vForm: TForm;
begin
  vForm := TForm(mClassForm.Create(nil));
  with vForm do try
    if Assigned(mFormShow) then mFormShow(vForm);
    Result := ShowModal;
    if Assigned(mFormClose) then mFormClose(vForm);
  finally
    Free;
  end;
end;

Answer 3

function ShowDialog(FormClass: TFormClass): Boolean;
var
  Dlg: TForm;
begin
  Application.CreateForm(FormClass, Dlg);
  try
    Result := Dlg.ShowModal in [mrOk, mrYes];
  finally
    Dlg.Free;
  end;
end; 
使用：ShowDialog(TForm1);{sc----------------------------------------------------------------------- 
          +++++显示窗体函数：供内部调用。可使窗体只Create一次+++++ 
                        -----参数说明： 
                            FormClass：窗体名 
                            Caption: 窗体标题 
                          Restore：显示为原来大小。 
-----------------------------------------------------------------------sc} function InternalFindShowForm(FormClass: TFormClass; 
  const Caption: string; Restore: Boolean): TForm; 
var 
  I: Integer; 
begin 
  Result := nil; 
  for I := 0 to Screen.FormCount - 1 do begin 
    if Screen.Forms[I] is FormClass then 
      if (Caption = '') or (Caption = Screen.Forms[I].Caption) then begin 
        Result := Screen.Forms[I]; 
        Break; 
      end; 
  end; 
  if Result = nil then begin 
    Application.CreateForm(FormClass, Result); 
    if Caption <> '' then Result.Caption := Caption; 
  end; 
  with Result do begin 
    if Restore and (WindowState = wsMinimized) then WindowState := wsNormal; 
    Show; 
  end; 
end;

Answer 4

WilliamGui(寒锋)　繁体WIN有没有下载的？？？[email protected]

Answer 5

外面有D版﹐下載浪費精力根據上面大家的意建﹐我寫了個函數:function OpenWindow(AForm:TForm; ATFormClass:TFormClass; AOwner:TComponent;
  AOpenMethod:integer=1):integer;
begin
  AForm:=ATFormClass.Create(AOwner);
  if AOpenMethod=0 then begin
    try
      AForm.Show;
      Result:=0;
    except
      AForm.free;
      Result:=-1;
    end;
  end else begin
    try
      Result:=AForm.ShowModal;
      AForm.free;
    except
      Result:=-1;
    end;
  end;
end;但我覺得上面我寫的﹐有些多此一舉,ATFormClass是否可以從AForm的屬性得到:
我試了一下:  AForm:=AForm.ClassType.create;
  AForm.ShowModal;
  AForm.free;可以運行﹐ 但 Owner 又如何呢?請大家指教!!!!!
********************************
我寫了一個小小的公共的pas文件﹐有不對或﹐有更多有用的函數過程﹐還有煩大家多提醒
********************************
////////////////////////////////////////////////////////////////
//     Author: WilliamGui                                     //
//     Modify Date: 2001-04-20                                //
//     Visit my personal WebSite: http://21sparrow.yeah.net   //
////////////////////////////////////////////////////////////////
unit wgpubcode;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI;{-$define _ENG}
{$define _BG}
{-$define _BIG5}{--- Common Function ---}
//About String Function
function StrRepeat(AProcessString:string; n:integer):string;
const
  {$ifdef _BG}
    UNITAGE_STR         :String = '&#63319;唱夆砬&#63319;唱夆勀&#63319;唱夆啋褒煦';
    UPPER_STR           :String = '錨瓞楚統佹斪翻&#63218;副墾';
    CURRENCY_UOM_STR    :string = '啋褒煦';
    CURRENCY_SUFFIX_STR :string = '淕淏蛹';
{$endif}
  {$ifdef _BIG5}
    UNITAGE_STR         :String = '仟佰拾億仟佰拾万仟佰拾元角分';
    UPPER_STR           :String = '零壹貳參肆伍陸柒捌玖';
    CURRENCY_UOM_STR    :string = '元角分';
    CURRENCY_SUFFIX_STR :string = '整正負';
{$endif}
//{$ifdef _BG or _BIG5}
{$ifdef _BG}
function CurrencyToChinese(ACurrency: Currency; Default: String=''):String;
{$endif}
//About Datetime Function
function GetItYear(AProcessDate:TDate):integer;
function GetItMonth(AProcessDate:TDate):integer;
function GetItDay(AProcessDate:TDate):integer;
function GetYear:integer;
function GetMonth:integer;
function GetDay:integer;
function GetFirstDayOfMonth(AProcessDate:TDate):TDate;
function GetLastDayOfMonth(AProcessDate:TDate):TDate;
function GetDayCountOfMonth(AProcessDate:TDate):integer;
function GetFirstDayOfPriorMonth(AProcessDate:TDate):TDate;
function GetLastDayOfPriorMonth(AProcessDate:TDate):TDate;
function GetDayCountOfPriorMonth(AProcessDate:TDate):integer;
function GetFirstDayOfNextMonth(AProcessDate:TDate):TDate;
function GetLastDayOfNextMonth(AProcessDate:TDate):TDate;
function GetDayCountOfNextMonth(AProcessDate:TDate):integer;
{--- MessageBox ---}
const
  {$ifdef _ENG}
    TIP_STRING='Tip';
    WARNING_STRING='Warning';
    ERROR_STRING='Error';
    CONFIRM_STRING='Confirm';
    QUERY_DELETE_STRING='   Are you sure to delete this record(Y/N)?     ';
    QUERY_SAVE_STRING='   Are you save it(Y/N)?   ';
    QUERY_EXIT_STRING='   Are you sure to exit(Y/N)?     ';
    NOT_DEVELOP_FINISH_STRING='   The function is developing ......   ';
  {$endif}
  {$ifdef _BG}
    TIP_STRING='枑尨';
    WARNING_STRING='劑豢';
    ERROR_STRING='渣昫';
    CONFIRM_STRING='&#63489;&#63513;';
    QUERY_DELETE_STRING='   岆瘁猁刉壺涴沭暮翹(Y/N)?     ';
    QUERY_SAVE_STRING='   岆瘁湔攫(Y/N)?   ';
    QUERY_EXIT_STRING='   岆瘁淩腕猁豖堤(Y/N)?     ';
    NOT_DEVELOP_FINISH_STRING='   蜆髡夔遜婓羲楷笢......   ';
  {$endif}
  {$ifdef _BIG5}
    TIP_STRING='提示';
    WARNING_STRING='警告';
    ERROR_STRING='錯誤';
    CONFIRM_STRING='確認';
    QUERY_DELETE_STRING='   是否要刪除這條記錄(Y/N)?     ';
    QUERY_SAVE_STRING='   是否存盤(Y/N)?   ';
    QUERY_EXIT_STRING='   是否真得要退出(Y/N)?     ';
    NOT_DEVELOP_FINISH_STRING='   該功能還在開發中......   ';
  {$endif}
{ New MessageBox 2001/08/01}
function InfoMsgBox(AInformationString:String):integer ;
function WarningMsgBox(AWarningString:String):integer ;
function ErrorMsgBox(AErrorString:String):integer ;
function QueryMsgBox(AQuestionString:String;ADefaultButton:integer=1):integer ;
function ConfMsgBox(AQuestionString:String;ADefaultButton:integer=1):integer ;
function QueryDelMsgBox(ADeleteString:String=QUERY_DELETE_STRING):integer;
function QuerySaveMsgBox(ASaveString:String=QUERY_SAVE_STRING):integer;
function QueryExitMsgBox(AExitString:String=QUERY_EXIT_STRING):integer;
function NotDevelopFinishMsgBox(ANotDevelopFinishString:String=NOT_DEVELOP_FINISH_STRING):integer ;{--- Voice ---}
function OpenWindow(AForm:TForm; ATFormClass:TFormClass; AOwner:TComponent; AOpenMethod:integer=1):integer;{--- Voice ---}
type
  TBleepType =(vOK,vInterrupt,vError);
procedure Bleep(BleepType : TBleepType);   //楷堤汒秞
procedure Sound(dFreq:double; wLong:word); //楷堤跪秞論汒秞
{ #49,#97: sound(261.7,400);  C
  #50,#98: sound(293.7,400);  D
  #51,#99: sound(329.6,400);  E
  #52,#100: sound(349.2,400); F
  #53,#101: sound(392.0,400); G
  #54,#102: sound(440.0,400); A
  #55,#103: sound(493.9,400); B }{--- About System ---}
function DiskInDrive(Drive: Char): Boolean; //&#63402;雄&#63239;岆瘁袧掘疑
function GetWindowsTempPath: string;{--- About Network ---}
function GetLoginName:string;{--- Code ---}implementationfunction StrRepeat(AProcessString:string; n:integer):string;
var
i:integer;
  TempVar:String;
begin
TempVar:='';
for i:=1 to n do
  begin
TempVar:=TempVar+AProcessString;
  end;
  Result:=TempVar;
end;{$ifndef _ENG}
function CurrencyToChinese(ACurrency: Currency; Default: String=''): String;
  function RightStr(S: String; N: Integer): String;   // 殿隙硌隅趼睫揹腔衵晚 N 跺趼睫
  var
    Start: Integer;
  begin
    Start := Length(S) - N + 1 ;
    if Start <= Length(S) then
      Result := Copy(S, Start, N)
    else
      Result := '';
  end;
var
  LowStr                 : String;    // 苤迡踢塗趼睫揹
  CurrentChar            : Char;      // 絞&#63325;杅硉腔ASCII鎢
  CurrentNum             : Integer;   // 絞&#63325;杅硉
  UpperStr, UnitageChar  : String[4]; // 湮迡踢塗趼睫揹睿踢塗等弇趼睫揹
  CurrentPos, UnitagePos : Integer;   // 坰竘
begin
  // Is Zero?
  if ACurrency=0 then begin
    Result := Default;
    Exit;
  end;
  Result := '';
  FmtStr(LowStr, '%15.2f', [ACurrency]); // Convert to string
  LowStr := Trim(LowStr);
  if ACurrency<0 then LowStr := Copy(LowStr, 2, Length(LowStr)-1); // &#63537;彆岆蛹硉ㄛ珂參趼睫揹爵腔饒跺蛹瘍&#63471;裁
  CurrentPos := 1;
  UnitagePos := 15 - Length(LowStr);
  while UnitagePos<14 do begin
    CurrentChar := LowStr[CurrentPos];   // &#63467;絞&#63325;弇杅趼
    if (CurrentChar>'9') or (CurrentChar<'0') then begin // &#63467;善腔趼睫褫夔祥岆杅趼ㄗ掀&#63537;佽岆苤杅萸ㄘ
      Inc(CurrentPos);
      Continue;
    end;
    CurrentNum := Ord(CurrentChar) - Ord('0');                 // &#63467;絞&#63325;杅趼腔硉
    UpperStr := Copy(UPPER_STR, (CurrentNum shl 1)+1, 2);      // &#63467;眈茼腔湮迡笢恅
    UnitageChar := Copy(UNITAGE_STR, (UnitagePos shl 1)+1, 2); // 眈茼腔等弇
    if (CurrentNum<>0) then begin   // &#63537;彆&#63467;腕腔杅趼祥岆錨ㄛ竭潠等ㄛ婓趼睫揹綴醱氝樓奻杅硉睿等弇憩俴賸
      Result := Result + UpperStr + UnitageChar;
      Inc(UnitagePos); Inc(CurrentPos);
      Continue;
    end;
    if RightStr(Result, 2) <> copy(UPPER_STR,1,2) then Result := Result + copy(UPPER_STR,1,2);   // 岆錨憩鎊歲賸ㄛ珂艘艘岆祥岆笭葩錨ㄛ祥岆憩珂樓珨跺'錨'婬佽
    { &#63537;彆岆錨&#63359;衱淏疑婓'砬'﹜'勀'﹜'啋'涴&#63559;跺弇离奻ㄛ憩＃＃
      湮模飲&#63378;奠ㄛ羶衄'統夆錨啋'麼'楚夆錨勀墾&#63319;'涴笱佽楊ㄛ硐衄
      '統夆啋'睿'楚夆勀墾&#63319;'ㄛ秪森猁刉&#63471;奻醱饒曆測鎢垀樓腔'錨'趼睫 }
    if ( UnitageChar=copy(UNITAGE_STR,7,2) ) or ( UnitageChar=copy(UNITAGE_STR,15,2) ) or (UnitageChar='元') then begin
      Delete(Result, Length(Result)-1, 2);
      if RightStr(Result, 2)<>copy(UNITAGE_STR,7,2) then Result := Result + UnitageChar;   // 遜猁艘艘&#63325;珨弇岆祥岆'砬'弇ㄛ岆憩祥樓等弇賸
      Result := Result + copy(UPPER_STR,1,2);
    end;
    Inc(UnitagePos);
    Inc(CurrentPos);
  end;
  if RightStr(Result, 2)=copy(UPPER_STR,1,2) then Result := Copy(Result, 1, Length(Result)-2);   // 挼ㄛ笝衾蛌遙俇賸ㄛ梗疆ㄛ&#63537;彆賦彆腔藺帣岆'錨'遜猁刉&#63471;坳
  if Copy(Result, 1, 2)=copy(UPPER_STR,1,2) then Result := Copy(Result, 3, Length(Result)-2);   // &#63537;彆賦彆腔羲宎憩岆錨ㄛ珩猁刉壺坳
  if RightStr(Result, 2)=copy(CURRENCY_UOM_STR,3,2) then
    Result := Result + copy(CURRENCY_SUFFIX_STR,3,2)   // &#63537;彆賦彆淏疑岆'XXXX褒'ㄛ偌炾嫦茼蜆樓奻珨跺'XXXX褒淏'
  else if RightStr(Result, 2)<>copy(CURRENCY_UOM_STR,5,2) then
    Result := Result + copy(CURRENCY_SUFFIX_STR,1,2);   // &#63537;彆賦彆祥岆'XXXX煦ㄛ憩猁樓奻珨跺'淕'趼
  if Copy(Result, 1, 2)=copy(CURRENCY_UOM_STR,1,2) then Result := RightStr(Result, Length(Result)-4); // 遜衄珨跺苤恀枙ㄛ憩岆......
  if ACurrency<0 then Result := copy(CURRENCY_SUFFIX_STR,5,2) + Result;   // 郔綴ㄛ&#63537;彆岆蛹硉遜猁樓奻珨跺'蛹'
end;
{$endif}function InfoMsgBox(AInformationString:String):integer;
begin
Result:=MessageBox(GetActiveWindow,PChar(AInformationString),PChar(TIP_STRING),MB_ICONINFORMATION+MB_OK);
end;function WarningMsgBox(AWarningString:String):integer ;
begin
Result:=MessageBox(GetActiveWindow,PChar(AWarningString),PChar(WARNING_STRING),MB_ICONWARNING+MB_OK);
end;function ErrorMsgBox(AErrorString:String):integer ;
begin
Result:=MessageBox(GetActiveWindow,PChar(AErrorString),PChar(ERROR_STRING),MB_ICONERROR+MB_OK);
end;
function QueryMsgBox(AQuestionString:String;ADefaultButton:integer=1):integer ;
begin
if ADefaultButton=2 then
Result:=MessageBox(GetActiveWindow,PChar(AQuestionString),PChar(CONFIRM_STRING),MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON2)
else
Result:=MessageBox(GetActiveWindow,PChar(AQuestionString),PChar(CONFIRM_STRING),MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON1);
end;function ConfMsgBox(AQuestionString:String;ADefaultButton:integer=1):integer ;
begin
Result:=QueryMsgBox(AQuestionString,ADefaultButton);
end;function QueryDelMsgBox(ADeleteString:String=QUERY_DELETE_STRING):integer;
begin
Result:=QueryMsgBox(ADeleteString,2);
end;function QuerySaveMsgBox(ASaveString:String=QUERY_SAVE_STRING):integer;
begin
Result:=QueryMsgBox(ASaveString);
end;function QueryExitMsgBox(AExitString:String=QUERY_EXIT_STRING):integer;
begin
Result:=QueryMsgBox(AExitString,2);
end;function NotDevelopFinishMsgBox(ANotDevelopFinishString:String=NOT_DEVELOP_FINISH_STRING):integer ;
begin
Result:=InfoMsgBox(ANotDevelopFinishString);
end;Procedure AsmShutUp; Pascal;
Begin
  Asm
    In AL, $61  { Stop Bleeping }
    And AL, $FC
    Out $61, AL
  End;
End;
Procedure AsmBeep (Freq : Word); Pascal;
Label
  Skip;
Begin
  Asm
      Push BX
      In AL, $61
      Mov BL, AL
      And AL, 3
      Jne Skip
      //Jne @Skip
      Mov AL, BL
      Or AL, 3
      Out $61, AL
      Mov AL, $B6
      Out $43, AL
    Skip: Mov AX, Freq
    //@Skip: Mov AX, Freq
      Out $42, AL
      Mov AL, AH
      Out $42, AL
      Pop BX
  End;
End;
Procedure HardBleep (Freq : Word; MSecs : Integer);
Var
  FirstTickCount:DWord;
Begin
  If (Freq>=20) And (Freq<=5000) Then Begin
    AsmBeep (Word (1193181 Div LongInt(Freq)));
    If MSecs>=0 Then Begin
      FirstTickCount:=GetTickCount;
      Repeat
        If MSecs>1000 Then Application.ProcessMessages;
      //Until ((GetTickCount-FirstTickCount)>LongInt(MSecs));
      Until (LongInt(GetTickCount-FirstTickCount)>LongInt(MSecs));
      AsmShutUp;
    End;
  End;
End;
Var SysWinNT : Boolean;
Procedure DoBleep (Freq : Word; MSecs : Integer);
Begin
  If SysWinNT Then Windows.Beep(Freq, MSecs) Else HardBleep(Freq, MSecs);
End;
{ Added to help counter the effects of DoBleep (Freq, -1).
  If you are producing a tone, & you want to stop without doing another Bleep, call this procedure }
//Procedure ShutUp;
//Begin
//  If SysWinNT Then Windows.Beep(1, 0) Else AsmShutUp;
//End;
Procedure Bleep(BleepType : TBleepType);
Begin
  Case BleepType of
    vOK:Begin
        DoBleep (1047,100);
        DoBleep (1109,100);
        DoBleep (1175,100);
    End;
    vInterrupt:Begin
        DoBleep (2093,100);
        DoBleep (1976,100);
        DoBleep (1857,100);
    End;
    vError:Begin
DoBleep (80,500);
     End;
  End;
End;
Procedure InitSysType;
Var
  VersionInfo:TOSVersionInfo;
Begin
  VersionInfo.dwOSVersionInfoSize:=SizeOf(VersionInfo);
  GetVersionEx(VersionInfo);
  SysWinNT:=VersionInfo.dwPlatformID=VER_PLATFORM_WIN32_NT;
End;procedure Sound(dFreq:double; wLong:word);
var
wFreq:word;
begin
wFreq:=round(1192576/dFreq);
  asm
   push ax
    push bx
    push cx
    push dx
    push di
    mov al,0b6h
    out 43h,al
    mov dx,12h
    mov ax,wFreq
    out 42h,al
    mov al,ah
    out 42h,al
    in al,61h
    mov ah,al
    or al,3
    out 61h,al
  @wait1:mov cx,wLong
  @delay:loop @delay
   dec bx
    jnz @wait1
    mov al,0b6h
    out 43h,al
    mov al,ah
    out 61h,al
    pop di
    pop dx
    pop cx
    pop bx
    pop ax
  end;
end;function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: word;
begin
  { make it upper case }
  if Drive in ['a'..'z'] then Dec(Drive, $20);
  { make sure it's a letter }
  if not (Drive in ['A'..'Z']) then raise EConvertError.Create('Not a valid drive ID');
  { turn off critical errors }
  ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
  try
    { drive 1 = a, 2 = b, 3 = c, etc. }
    if DiskSize(Ord(Drive) - $40) = -1 then
    Result := False
    else
     Result := True;
  finally
  { restore old error mode }
  SetErrorMode(ErrorMode);
  end;
end;function GetWindowsTempPath: string;
var
TempVar1: array[0..100] of Char;
begin
GetTempPath(100,TempVar1);
  Result:=trim(String(TempVar1));
end;function GetLoginName:string;
var
  lpBuffer:array [0..100] of Char;
  nSize:DWord;
begin
  nSize:=Sizeof(lpBuffer);
  GetUserName(lpBuffer,nSize);
  Result:=trim(lpBuffer);
end;function GetItYear(AProcessDate:TDate):integer;
var
TempVar1, TempVar2, TempVar3 :word;
begin
decodedate(AProcessDate,TempVar1,TempVar2,TempVar3);
  Result:=TempVar1;
end;function GetItMonth(AProcessDate:TDate):integer;
var
TempVar1, TempVar2, TempVar3 :word;
begin
decodedate(AProcessDate,TempVar1,TempVar2,TempVar3);
  Result:=TempVar2;
end;function GetItDay(AProcessDate:TDate):integer;
var
TempVar1, TempVar2, TempVar3 :word;
begin
decodedate(AProcessDate,TempVar1,TempVar2,TempVar3);
  Result:=TempVar3;
end;function GetYear:integer;
begin
Result:=GetItYear(Date);
end;function GetMonth:integer;
begin
Result:=GetItMonth(Date);
end;function GetDay:integer;
begin
Result:=GetItDay(Date);
end;function GetFirstDayOfMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
Result:=EncodeDate(TempVar1, TempVar2, 1);
end;function GetLastDayOfMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if ( TempVar2 = 12) then
    Result := EncodeDate(TempVar1+1, 1, 1)-1
  else
    Result := EncodeDate(TempVar1, TempVar2+1, 1)-1;
end;function GetDayCountOfMonth(AProcessDate:TDate):integer;
begin
Result:=GetItDay(GetLastDayOfMonth(AProcessDate));
end;function GetFirstDayOfPriorMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if TempVar2=1 then
    Result := EncodeDate(TempVar1-1, 12, 1)
  else
    Result := EncodeDate(TempVar1, TempVar2-1, 1);
end;function GetLastDayOfPriorMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
  if TempVar2=1 then begin
Result := EncodeDate(TempVar1-1, 12, 31);
  end else begin
Result := EncodeDate(TempVar1, TempVar2, 1)-1;
  end;
end;function GetDayCountOfPriorMonth(AProcessDate:TDate):integer;
begin
Result:=GetItDay(GetLastDayOfPriorMonth(AProcessDate));
end;function GetFirstDayOfNextMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
if ( TempVar2 = 12) then
    Result := EncodeDate(TempVar1+1, 1, 1)
  else
    Result := EncodeDate(TempVar1, TempVar2+1, 1);
end;function GetLastDayOfNextMonth(AProcessDate:TDate):TDate;
var
TempVar1, TempVar2, TempVar3 :word;
begin
DecodeDate(AProcessDate, TempVar1, TempVar2, TempVar3);
  case TempVar2 of
     11: Result := EncodeDate(TempVar1, 12, 31);
    12: Result := EncodeDate(TempVar1+1, 1, 31);
     else Result := EncodeDate(TempVar1, TempVar2+2, 1)-1;
  end;
end;function GetDayCountOfNextMonth(AProcessDate:TDate):integer;
begin
Result:=GetItDay(GetLastDayOfNextMonth(AProcessDate));
end;function OpenWindow(AForm:TForm; ATFormClass:TFormClass; AOwner:TComponent; AOpenMethod:integer=1):integer;
begin
AForm:=ATFormClass.Create(AOwner);
  if AOpenMethod=0 then begin
  try
      AForm.Show;
    Result:=0;
  except
     AForm.free;
    Result:=-1;
   end;
  end else begin
   try
    Result:=AForm.ShowModal;
      AForm.free;
    except
    Result:=-1;
    end;
  end;
end;{--- Initialization ---}Initialization
  InitSysType;end.