uthreadeddatamodulestatus.~pas

多线程调用的范例

unit uThreadedDataModuleStatus;

interface
uses
CLASSES, CONTROLS, GAUGES, STDCTRLS, WINDOWS, MESSAGES
  , VARIANTS,
    Graphics, SYSUTILS, ExtCtrls, DIALOGS,
  uThreadedDataModule, uThreadedInterfaces;

const
  Update_Display = wm_user + $500;
  Delete_Display = wm_user + $501;
type

  TStatusMessageEvent = procedure(Sender: TObject; StatusMessage: string) of object;
  TThreadedDisplayOption = (tdStatusBar, tdStatusMessage,
                            tdPauseThread, tdCancelThread);
  TThreadedDisplayOptions = set of TThreadedDisplayOption;

  TThreadedDataModuleStatus = class(TWinControl , IThreadedCallback)
  private
    // Properties
    FModuleDLL: string;
    FModuleName: string;
    FDisplayOptions: TThreadedDisplayOptions;
    FOnStatusMessage: TStatusMessageEvent;
    FMachineName: string;
    FProcessIndex: integer; // for DCOM stuff
    procedure SetModuleDLL(const Value: string);
    procedure SetModuleName(const Value: string);
    procedure SetDisplayOptions(const Value: TThreadedDisplayOptions);

  private
    // Internal Vars
    FGauge: TGauge;
    FStatusLabel: TLabel;
    FPauseBtn: TButton;
    FCancelBtn: TButton;
    FDLLHandle: HMODULE;
    FModuleCount: DataModuleCountFunc;
    FDataModule: DataModuleFunc;
    FDataModuleName: DataModuleNameFunc;
    FNeedToUpdate: boolean;

    FCurrentModuleRunning: IThreadedDatamodule;
    FCurrentProcessRunning: OleVariant;  // IRSIPRocess

    // Events for sub-controls
    procedure PauseClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);

    procedure UpdateDisplayOptions;
    procedure UnloadDLL;
    procedure LoadDLL;
    procedure UpdateDisplay;
    procedure UnloadModule;
    procedure WM_Update_Display(var Message: TMessage); message Update_Display;
    procedure WM_Delete_Display(var Message: TMessage); message Delete_Display;

  protected
    procedure Loaded; override;

    // ModuleLoaded - returns if the module has been loaded.  Used for local
    //    modules and remote modules.
    function GetModuleLoaded: boolean;
    property ModuleLoaded: boolean read GetModuleLoaded;

    // Current Module Running returns the current threaded datamodule created.
    function GetCurrentModuleRunning: IThreadedDatamodule;
    property CurrentModuleRunning: IThreadedDatamodule read GetCurrentModuleRunning;

    // LocalModule returns if this module is running on this machine.
    function GetLocalModule: boolean;
    property LocalModule: boolean read GetLocalModule;

  protected
    // IThreadedCallback
    FMin, FMax, FProgress: integer;
    FStatusMessage: string;
    function GetMin: integer;
    procedure SetMin(AValue: integer);
    property Min: integer read GetMin write SetMin;
    function GetMax: integer;
    procedure SetMax(AValue: integer);
    property Max: integer read GetMax write SetMax;
    function GetProgress: integer;
    procedure SetProgress(AValue: integer);
    property Progress: integer read GetProgress write SetProgress;
    function GetStatusMessage: string;
    procedure SetStatusMessage(AValue: string);
    property StatusMessage: string read GetStatusMessage write SetStatusMessage;
    procedure ModuleFinished;

  public
    procedure EnumModules(ModuleNames: TStrings);
    function CreateModule: IThreadedDataModule;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property ModuleDLL: string read FModuleDLL write SetModuleDLL;
    property ModuleName: string read FModuleName write SetModuleName;
    property MachineName: string read FMachineName write FMachineName;
    property DisplayOptions: TThreadedDisplayOptions
          read FDisplayOptions
          write SetDisplayOptions;
    property OnStatusMessage: TStatusMessageEvent read FOnStatusMessage write FOnStatusMessage;
  end;

implementation

{ TThreadedDataModuleStatus }

procedure TThreadedDataModuleStatus.CancelClick(Sender: TObject);
begin
  if CurrentModuleRunning = nil then Exit;
  FCancelBtn.Enabled:=False;
  CurrentModuleRunning.Terminate;
end;

constructor TThreadedDataModuleStatus.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDLLHANDLE:=0;
  FNeedToUpdate:=False;

  Parent:=TWinControl(AOwner);
  Left:=0;
  Top:=0;
  Width:=TWinControl(AOwner).Width;
  Height:=TWinControl(AOwner).Height;
  visible:=true;
  
  FStatusLabel:=TLabel.Create(nil);
  with FStatusLabel do
    begin
      Visible:=False;
      Parent:=Self;
      Left:=10;
      Top:=4;
      AutoSize:=True;
      Caption:='';
    end;

  FPauseBtn:=TButton.Create(nil);
  with FPauseBtn do
    begin
      Visible:=False;
      Parent:=Self;
      Caption:='Pause Thread';
      Width:=100;
      Left:=10;
      Top:=FStatusLabel.Height+FStatusLabel.Top+4;
      OnClick:=PauseClick;
    end;

  FCancelBtn:=TButton.Create(nil);
  with FCancelBtn do
    begin
      Visible:=False;
      Parent:=Self;
      Caption:='Cancel Thread';
      OnClick:=CancelClick;
      Width:=100;
      Left:=FPauseBtn.Width+FPauseBtn.Left+10;
      Top:=FStatusLabel.Height+FStatusLabel.Top+4;
    end;

  FGauge:=TGauge.Create(nil);
  with FGauge do
    begin
      Visible:=False;
      Parent:=Self;
      Width:=100;
      Left:=FCancelBtn.Left+FCancelBtn.Width+20;
      Top:=FStatusLabel.Height+FStatusLabel.Top+4;
      Height:=FCancelBtn.Height;
    end;

end;

function TThreadedDataModuleStatus.CreateModule: IThreadedDataModule;
var
  lv_ModuleList: TStringList;
  lvi_ModuleIndex: integer;
begin
  // This method loads the DLL, gets the Module index and returns a handle
  // to a created datamodule.
  // if machine name <> '' then the DCOM wrapper object is instantiated
  // and it's interface it returned.

  Result:=nil;
  if LocalModule then
    begin
      LoadDLL;
    end
  else
    begin
    end;

  if not ModuleLoaded then Exit;

  // Get Module Index
  lv_ModuleList:=TStringList.Create;
  try
    EnumModules(lv_ModuleList);
    lvi_ModuleIndex:=lv_ModuleList.IndexOf(FModuleName);
    if lvi_ModuleIndex = -1 then Exit;
  finally
    lv_ModuleList.Destroy;
  end;

  // Create the module.
  if LocalModule then
    begin
      if FCurrentModuleRunning <> nil then
        FCurrentModuleRunning:=nil;
      FCurrentModuleRunning:=FDataModule(lvi_ModuleIndex);
      FCurrentModuleRunning.CallBack:=Self;
      Result:=FCurrentModuleRunning;
    end
  else
    begin
    end;




  
end;

destructor TThreadedDataModuleStatus.Destroy;
begin
  FCurrentModuleRunning:=nil;
  FGauge.Destroy;
  FStatusLabel.Destroy;
  FPauseBtn.Destroy;
  FCancelBtn.Destroy;
  UnloadModule;
  inherited Destroy;
end;

procedure TThreadedDataModuleStatus.EnumModules(ModuleNames: TStrings);
var
  i: integer;
begin
  ModuleNames.Clear;
  if ModuleLoaded then
    for i:=0 to FModuleCount - 1 do
      ModuleNames.Add(FDataModuleName(i));
end;


function TThreadedDataModuleStatus.GetCurrentModuleRunning: IThreadedDatamodule;
begin
  Result:=nil;
  if not ModuleLoaded then Exit;
  Result:=FCurrentModuleRunning;
end;

function TThreadedDataModuleStatus.GetLocalModule: boolean;
begin
  Result:=FMachineName = '';
end;

function TThreadedDataModuleStatus.GetMax: integer;
begin
  Result:=FMax;
end;

function TThreadedDataModuleStatus.GetMin: integer;
begin
  Result:=FMin;
end;

function TThreadedDataModuleStatus.GetModuleLoaded: boolean;
begin
  // if there's a module running, that overrides all other checks
  if FCurrentModuleRunning <> nil then
    begin
      Result:=True;
      Exit
    end;
    
  if LocalModule then
    Result:=FDLLHandle <> 0
  else
    begin
      // NTI: remote check
    end;
end;


function TThreadedDataModuleStatus.GetProgress: integer;
begin
  Result:=FProgress;
end;

function TThreadedDataModuleStatus.GetStatusMessage: string;
begin
  Result:=FStatusMessage;
end;

procedure TThreadedDataModuleStatus.LoadDLL;
begin
  // Loads the Module DLL
  UnloadDLL;
  FDLLHandle:=LoadLibrary(PChar(FModuleDLL));
  if FDLLHandle <> 0 then
    begin
      FModuleCount:=GetProcAddress(FDLLHandle, 'DataModuleCount');
      FDataModule:=GetProcAddress(FDLLHandle, 'DataModule');
      FDataModuleName:=GetProcAddress(FDLLHandle, 'DataModuleName');
    end;
end;

procedure TThreadedDataModuleStatus.Loaded;
begin
  inherited Loaded;
  UpdateDisplayOptions;     // Once params are loaded show/hide items.
end;

procedure TThreadedDataModuleStatus.ModuleFinished;
begin
  // Called when the module is done.
  if FCurrentModuleRunning <> nil then
    FCurrentModuleRunning.Callback:=nil;

  FCurrentModuleRunning:=nil;

  // Part of an automated display.
end;

procedure TThreadedDataModuleStatus.PauseClick(Sender: TObject);
begin
  if CurrentModuleRunning = nil then Exit;
  if FPauseBtn.Caption = 'Pause Thread' then
    begin
      CurrentModuleRunning.Pause;
      FPauseBtn.Caption:='Resume';
    end
  else
    begin
      CurrentModuleRunning.Resume;
      FPauseBtn.Caption:='Pause Thread';
    end;
end;

procedure TThreadedDataModuleStatus.SetDisplayOptions(
  const Value: TThreadedDisplayOptions);
begin
  if FDisplayOptions = Value then Exit;
  FDisplayOptions:=Value;
  UpdateDisplayOptions;
end;

procedure TThreadedDataModuleStatus.SetMax(AValue: integer);
begin
  FMax:=AValue;
  UpdateDisplay;
end;

procedure TThreadedDataModuleStatus.SetMin(AValue: integer);
begin
  FMin:=AValue;
//  UpdateDisplay;
end;

procedure TThreadedDataModuleStatus.SetModuleDLL(const Value: string);
begin
  FModuleDLL:=Value;
end;

procedure TThreadedDataModuleStatus.SetModuleName(const Value: string);
begin
  FModuleName:=Value;
end;

procedure TThreadedDataModuleStatus.SetProgress(AValue: integer);
begin
  FProgress:=AValue;
  UpdateDisplay;
end;

procedure TThreadedDataModuleStatus.SetStatusMessage(AValue: string);
begin
  FStatusMessage:=AValue;
  UpdateDisplay;
end;

procedure TThreadedDataModuleStatus.UnloadDLL;
begin
  // Unloads the Module DLL
  if FDLLHandle <> 0 then
    begin
      FModuleCount:=nil;
      FDataModule:=nil;
      FDataModuleName:=nil;
      FreeLibrary(FDLLHandle);
      FDLLHandle:=0;
    end;
end;

procedure TThreadedDataModuleStatus.UnloadModule;
begin
  // unloads the DLL or unattaches from the DCOM wrapper
  if ModuleLoaded then
    if LocalModule then
      UnloadDLL
    else
      begin
        // NTI remote
      end;
end;

procedure TThreadedDataModuleStatus.UpdateDisplay;
begin
  // Called when datamodule updates a param.  sends a message to this control
  // to update itself.
  if FNeedToUpdate then Exit;
  FNeedToUpdate:=True;
  if Parent = nil then Exit;
  PostMessage(Self.Handle, Update_Display, 0, 0);
end;

procedure TThreadedDataModuleStatus.UpdateDisplayOptions;
var
  lvi_ControlTop: integer;
begin
  // Called when the display options change.  Changes the configuration of the
  // control.
  // NTI: cleaner interface
  FGauge.Visible:=tdStatusBar in FDisplayOptions;
  FStatusLabel.Visible:=tdStatusMessage in FDisplayOptions;
  FPauseBtn.Visible:=tdPauseThread in FDisplayOptions;
  FCancelBtn.Visible:=tdCancelThread in FDisplayOptions;

  if not FStatusLabel.Visible then
    lvi_ControlTop:=4
  else
    lvi_ControlTop:=FStatusLabel.Top+FStatusLabel.Height+4;

  FGauge.Top:=lvi_ControlTop;
  FGauge.Left:=Width - 10 - FGauge.Width;
  FPauseBtn.Top:=lvi_ControlTop;
  FCancelBtn.Top:=lvi_ControlTop;

end;

procedure TThreadedDataModuleStatus.WM_Delete_Display(
  var Message: TMessage);
begin
  Destroy;
end;

procedure TThreadedDataModuleStatus.WM_Update_Display(
  var Message: TMessage);
begin
  FGauge.MinValue:=FMin;
  FGauge.MaxValue:=FMax;
  FGauge.Progress:=FProgress;
  if FStatusLabel.Caption <> FStatusMessage then
    begin
      FStatusLabel.Caption:=FStatusMessage;
      if Assigned(FOnStatusMessage) then
        FOnStatusMessage(Self, FStatusMessage);
    end;
  FNeedToUpdate:=False;

end;

end.