cpwcdial.pas

生物信息学中的遗传数据分析的delphi源码。

{*********************************************}
{                                             }
{    COMPONENT for MS DOS and MS WINDOWS      }
{                                             }
{    Source code for Turbo Pascal 6.0 and     }
{    Turbo Pasacal for Windows 1.0 compilers. }
{                                             }
{    (c) 1991, Roderic D. M. Page             }
{                                             }
{*********************************************}


{*
   A simple counter dialog that displays the progress
   of an analysis, and lets user interupt the process
   if necessary.

   Dialog box also supports custom meter controls as well.


   Usage
   -----

   1. Create the dialog window as a modeless dialog box.

      Counter := new (PCounterDialog, Init (@Self, 'TEST_DIALOG'));
      Application^.MakeWindow (PDialog);

   2. Call the program code, which updates the dialog box

      [ some code ]
      .
      .
      .
      Counter^.UpDateNumber (id_Number, i);
      .
      .
      .
      [ more code ]

   3. When process is complete, update the dialog box and
      wait for user to clear it.

      if bUserAbort then
         Counter^.UserAborted
      else Counter^.Successful;
      repeat
      until Counter^.Cleared;

      This will make the dialog box display replace the Cancel button with
      the OK button. The dialog box remains on screen until user clicks
      on the OK button.

      Note that everytime the program calls a Counter method the
      procedure PassOnMsg is called by that method so that Windows
      always gets a chance to process any messages.


   History
   -------

    4 Oct 1991  Written.

    9 Oct 1991  Support for custom meter controls added.

    7 Nov 1991  proc PassOnMsg modified. Previously dialog box would
                not respond to Return key being pressed. As Pretzold
                (p. 472-473, and 753) notes, this is because the dialog
                box is modeless. By first calling IsDialogMessage (API)
                before passing on messages, and making the "Cancel/OK"
                key the default pushbutton, then user can abort by
                pressing either the button or return.

     9 Dec 1991 Now supports dialog boxes with both OK and Cancel
                buttons.

*}

unit cpwcdial;

interface

uses
   WinTypes,
   WinProcs,
	{$IFDEF BWCC}   { use Borland-style dialogs }
   {$IFDEF VER10}
   WObjectB,
   BWCC,
	{$ELSE}         { use standard dialogs }
   WObjects,
	{$ENDIF}
	{$ELSE}         
   WObjects,
   {$ENDIF}

	MeterCo;

const
   id_Status = 150;  { status control id }

type
  PCounterDialog = ^CounterDialog;
  CounterDialog = object(TDialog)
     constructor Init (AParent: PWindowsObject; AName:PChar);
     procedure PassOnMsg;
     procedure OKButton;
     procedure Successful;
     procedure UserAborted;
     procedure Error;
     procedure UpDateText (id:integer; s:PChar);
     procedure UpDateNumber (id:integer; i:longint);
     procedure UpDateMeter (id:integer; PartsComplete: word);
     procedure SetMeter (id:integer; PartsInJob: word);
     procedure Cancel(var Msg:TMessage);virtual id_First + id_Cancel;
     procedure OK(var Msg:TMessage);virtual id_First + id_OK;
     function Cleared:Boolean;
     private
     bDone    : Boolean;    { true if process completed or interupted }
     bCleared : Boolean;    { true if window closed }
     end;

var
   bUserAbort : Boolean; { true if user interupts }
   Counter    : PCounterDialog;

implementation

const
   DIGITS = 10;

{-----------------------------Init-----------------------------------------}

{ Disable the parent window and set the bDone and
  bUserAbort flags to false. }
constructor CounterDialog.Init (AParent: PWindowsObject; AName:PChar);
begin
   TDialog.Init (AParent, AName);
   EnableWindow (AParent^.HWindow, False);
   bDone      := False;
   bUserAbort := False;
   bCleared   := False;
   EnableKBHandler;
end;

{-----------------------------Cancel---------------------------------------}

{ Override TDialog.Cancel. Initially the Cancel button (id_Cancel)
  is labeled "Cancel" and bDone is false. If user clicks on this button
  the process is aborted so the bUserAbort flag is set. If the process
  is done then dialog is destroyed and parent window enabled. }
procedure CounterDialog.Cancel (var Msg:TMessage);
begin
   if not bDone then begin
      if not bUserAbort then
         bUserAbort := true;
      end
   else begin
      EnableWindow (Parent^.HWindow, True);  { this line must be first }
{      TDialog.Cancel (Msg);}
      bCleared := True;
      end;
end;

{-----------------------------OKButton-------------------------------------}

{ Either replace Cancel button text with "OK", or
  enable OK button (if it exists) and gray the cancel button.}
procedure CounterDialog.OKButton;
var
   OKHWnd : HWnd;
begin
   bDone := True;
(*   SetWindowText (GetDlgItem (HWindow, id_Cancel), 'OK')*)

   OKHWnd := GetDlgItem (HWindow, id_OK);
   if (OKHWnd = 0) then
      SetWindowText (GetDlgItem (HWindow, id_Cancel), 'OK')
   else begin

      { Make cancel button a normal push button and disable it. }
      SendDlgItemMessage (HWindow, id_Cancel, bm_SetStyle, bs_PushButton, 1);
      EnableWindow (GetDlgItem (HWindow, id_Cancel), False);

      { Enable OK button and make it the default push button
        with the focus. }
      EnableWindow (OKHWnd, True);
      SendMessage (OKHWnd, bm_SetStyle, bs_DefPushButton, 1);
      SetFocus (OKHWnd);
      end;
end;

{-----------------------------OK-------------------------------------------}

procedure CounterDialog.OK(var Msg:TMessage);
begin
   EnableWindow (Parent^.HWindow, True);  { this line must be first }
   bCleared := true;
end;

{-----------------------------UserAborted----------------------------------}

{ Hook for using routine, sets status message and calls OKButton }
procedure CounterDialog.UserAborted;
begin
   SetWindowText (GetDlgItem (HWindow, id_Status), 'User terminated');
   OKButton;
end;

{-----------------------------Successful-----------------------------------}

{ Hook for using routine, sets status message and calls OKButton }
procedure CounterDialog.Successful;
begin
   SetWindowText (GetDlgItem (HWindow, id_Status), 'Successful');
   OKButton;
end;

{-----------------------------Error----------------------------------------}

{ Hook for using routine, sets status message and calls OKButton }
procedure CounterDialog.Error;
begin
   SetWindowText (GetDlgItem (HWindow, id_Status), 'Error');
   OKButton;
end;

{-----------------------------Cleared--------------------------------------}

function CounterDialog.Cleared:Boolean;
begin
   PassOnMsg;
   Cleared := bCleared;
end;

{-----------------------------PassOnMsg------------------------------------}

{ Called by all updating procedures below, so that Windows has a chance
  to process any messages while user program is running. }
procedure CounterDialog.PassOnMsg;
var
   Msg: TMsg;
begin
   { Use Windows API PeekMessage function to dispatch
     any messages. If user has pressed Cancel button
     on dialog box, then that message will be dispatched
     here. Must use flag pm_Remove otherwise we'll
     be in an infinite loop. }
   while PeekMessage (Msg, 0, 0, 0, pm_Remove) do
      if not IsDialogMessage (HWindow, Msg) then begin
         TranslateMessage (Msg);
         DispatchMessage (Msg);
         end;
end;

{-----------------------------UpDateText-----------------------------------}

{ Display a string using the TStatic control with given id }
procedure CounterDialog.UpDateText (id:integer; s:PChar);
var
  H: HWnd;
begin
   SetWindowText (GetDlgItem (HWindow, id), s);
   PassOnMsg;
end;

{-----------------------------UpDateNumber---------------------------------}

{ Display an integer using TStatic control id }
procedure CounterDialog.UpDateNumber (id:integer; i:longint);
var
   s: array[0..DIGITS] of char;
begin
   wvsprintf (s, '%d', i);
{   Str (i, s);            }
   UpDateText (id, s);
end;

{-----------------------------UpDateMeter----------------------------------}

{ Update a meter display }
procedure CounterDialog.UpDateMeter (id:integer; PartsComplete: word);
begin
   SendDlgItemMessage (HWindow, id, mm_SETPARTSCOMPLETE, PartsComplete, 0);
   PassOnMsg;
end;

{-----------------------------SetMeter-------------------------------------}

{ Set meter range }
procedure CounterDialog.SetMeter (id:integer; PartsInJob: word);
begin
   SendDlgItemMessage (HWindow, id, mm_SETPARTSINJOB, PartsInJob, 0);
   PassOnMsg;
end;



begin
end.