bthreadeditors.pas

Tread Component for Delphi

unit BThreadEditors;

interface

{$IFDEF VER170} // Delphi 9.0
{$DEFINE D7}
{$DEFINE D6}
{$DEFINE D9}
{$ENDIF}

{$IFDEF VER150} // Delphi 7.0
{$DEFINE D6}
{$DEFINE D7}
{$ENDIF}

{$IFDEF VER140} // Delphi 6.0
{$DEFINE D6}
{$ENDIF}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
{$IFDEF D6}
  DesignIntf,
  DesignEditors,
{$ELSE}
  Dsgnintf,
{$ENDIF}
  Dialogs, TypInfo,
{$IFDEF D9}
  ToolsApi,
{$ELSE}
  ExptIntf,
  EditIntf, ToolIntf,
{$ENDIF}
  BusThread,
  ExtCtrls, ComCtrls, StdCtrls, Buttons, Clipbrd;

{$IFDEF D6}
type IFormDesigner = IDesigner;
{$ENDIF}

type
{$IFDEF D9}
  TFileNotifyEvent = procedure(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean) of object;
{$ELSE}
  TFileNotifyEvent = procedure(NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean) of object;
{$ENDIF}
//  TEventNotifyEvent = procedure(NotifyCode: TEventNotification; var Cancel: Boolean) of object;

type
  TEventsEditorNotification = class;

  TSynchroMethodsForm = class(TForm)
    PageControl: TPageControl;
    ThreadSynchroTabSheet: TTabSheet;
    ThreadEventsListView: TListView;
    Panel1: TPanel;
    CreateGroupBox: TGroupBox;
    BtnNoDataEvent: TBitBtn;
    BtnDataEvent: TBitBtn;
    RenameButton1: TBitBtn;
    ShowButton1: TBitBtn;
    Panel3: TPanel;
    CopyCallButton1: TBitBtn;
    GenCallButton1: TBitBtn;
    RefreshButton1: TBitBtn;
    TabSheet2: TTabSheet;
    StdEventsListView: TListView;
    Panel2: TPanel;
    NewStdButton: TBitBtn;
    RenameButton2: TBitBtn;
    ShowButton2: TBitBtn;
    Panel4: TPanel;
    CopyCallButton2: TBitBtn;
    GenCallButton2: TBitBtn;
    RefreshButton2: TBitBtn;
    StatusBar: TStatusBar;
    Timer1: TTimer;
    procedure PageControlChange(Sender: TObject);
    procedure RefreshButton1Click(Sender: TObject);
    procedure BtnNoDataEventClick(Sender: TObject);
    procedure BtnDataEventClick(Sender: TObject);
    procedure RenameButton1Click(Sender: TObject);
    procedure ShowButton1Click(Sender: TObject);
    procedure CopyCallButton1Click(Sender: TObject);
    procedure GenCallButton1Click(Sender: TObject);
    procedure NewStdButtonClick(Sender: TObject);
    procedure ThreadEventsListViewChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ThreadEventsListViewEdited(Sender: TObject; Item: TListItem;
      var S: string);
    procedure ThreadEventsListViewKeyPress(Sender: TObject; var Key: Char);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    IDENotifierID : Integer;
  protected
    Designer: IFormDesigner;
    UpdateNotifier: TEventsEditorNotification;
    ActiveListView: TListView;
    ThreadEventsList: TStringList;
    StdEventsList: TStringList;
    procedure AddMethodNoDataEntry(const S: string);
    procedure AddMethodDataEntry(const S: string);
    procedure AddStandardNotifyEntry(const S: string);
    function AddMethodNoDataItem(const S: string): TListItem;
    function AddMethodDataItem(const S: string): TListItem;
    function AddStandardNotifyItem(const S: string): TListItem;
    procedure ValidateComponents;
    procedure UpdateView;
    procedure ClearLists;
//    procedure OnFileNotify(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
    procedure OnUpdateNotify(Sender : TObject);
    procedure OnCloseNotify(Sender : TObject);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent; _Designer: IFormDesigner); reintroduce; overload;
    destructor Destroy; override;
    procedure SetDesigner(_Designer: IFormDesigner);
  end;

  TBThreadControlEditor = class(TComponentEditor)
  public
//    destructor Destroy; override;
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount(): Integer; override;
  end;

  TEmptyEntryPropertyEditor = class(TPropertyEditor)
    function GetValue: string; override;
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

{$IFDEF D9}
  TEventsEditorNotification = class( TNotifierObject, IOTANotifier, IOTAIDENotifier )
    FOnUpdateNotify : TNotifyEvent;
    FOnCloseNotify  : TNotifyEvent;
    
    procedure AfterSave;
    { This function is called immediately before the item is saved. This is not
      called for IOTAWizard }
    procedure BeforeSave;
    { The associated item is being destroyed so all references should be dropped.
      Exceptions are ignored. }
    procedure Destroyed;
    { This associated item was modified in some way. This is not called for
      IOTAWizards }
    procedure Modified;

    procedure FileNotification(NotifyCode: TOTAFileNotification;
      const FileName: string; var Cancel: Boolean);
    { This function is called immediately before the compiler is invoked.
      Set Cancel to True to cancel the compile }
    procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean); overload;
    { This procedure is called immediately following a compile.  Succeeded
      will be true if the compile was successful }
    procedure AfterCompile(Succeeded: Boolean); overload;
  end;
{$ELSE}
  TEventsEditorNotification = class(TIAddInNotifier)
  public
    FOnUpdateNotify : TNotifyEvent;
    FOnCloseNotify: TNotifyEvent;
//    FOnEventNotify: TEventNotifyEvent;
    procedure FileNotification(NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean); override; stdcall;
    procedure EventNotification(NotifyCode: TEventNotification; var Cancel: Boolean); override; stdcall;
  public
    {
     inline __fastcall TEventsEditorNotification (void)
              ToolServices->AddNotifierEx ( this );
    }
  public
    {	inline __fastcall virtual ~TEventsEditorNotification(void)
              ToolServices->RemoveNotifier ( this );
    }
  end;
{$ENDIF}

procedure Register;

implementation

{$R *.DFM}

type
  TThreadEventSruct = class(TObject)
  public
    Parameter: string;
    CallingFormat: string;
  end;

var
  DesignForm: TSynchroMethodsForm;

function GenerateEventName(Designer: IFormDesigner; TamplateName: string): string;
var
  I: Integer;
  GeneratedName: string;
begin
  GeneratedName := TamplateName;
  I := 0;
  repeat
    Inc(I);
    GeneratedName := TamplateName + IntToStr(I);
  until (not Designer.MethodExists(GeneratedName));
  Result := GeneratedName;
end;

function GenerateEvent(Designer: IFormDesigner; TypeID: Pointer; NameTamplate: string): string;
var
  GeneratedName: string;
begin
  //  PPropInfo PropInfo = ::GetPropInfo ( __typeinfo(TBMSynchroEventsEditorHelperClass), EventPropertyName );
  GeneratedName := GenerateEventName(Designer, NameTamplate);
  Designer.CreateMethod(GeneratedName, TypeID);
  Designer.ShowMethod(GeneratedName);
  Result := GeneratedName;
end;

{$IFDEF D9}
function GetCurrentEditView(EditorIntf: IOTASourceEditor): Integer;
var
  EditorFileName: string;
  WindowIterator: HWND;
  Buffer: array[0..255] of Char;
  APos: PChar;
begin
  Assert(EditorIntf <> nil);
  Result := 0;
  if EditorIntf.GetSubViewCount = 1 then
  begin
    // If there is only one edit view, then it is clear that
    // the first one is the current edit view
    Result := 0;
  end
  else
  begin
    EditorFileName := UpperCase(ExtractFileName(EditorIntf.FileName));
    WindowIterator := GetWindow(GetDesktopWindow, GW_CHILD);
    // Iterate over all windows whose owner is the Desktop
    WindowIterator := GetWindow(WindowIterator, GW_HWNDNEXT);
    // If we find a window with the class name "TEditWindow"
    // and the filenames match then this is the currently active
    // edit view
    while (WindowIterator <> 0) and IsWindow(WindowIterator) do
    begin
      if GetClassName(WindowIterator, Buffer, SizeOf(Buffer) - 1) = 0 then
        RaiseLastWin32Error;
      if StrPos(Buffer, 'TEditWindow') <> nil then
      begin
        if GetWindowText(WindowIterator, Buffer, SizeOf(Buffer) - 1) = 0 then
          RaiseLastWin32Error;
        StrUpper(Buffer);
        if StrPos(Buffer, PChar(EditorFileName)) <> nil then
        begin
          // I the case where there are multiple edit windows
          // open the first one you come to in the iteration process
          // should always be the top-most (or most recently active) edit
          // window - JCH
          // Scan window caption from the end; if we started at the
          // beginning, we might run into the colon of C:\MyFile
          APos := StrRScan(Buffer, ':');
          Inc(APos);
          Result := StrToIntDef(StrPas(APos), -1);
          // Subtract 1 since we need 0..GetViewCount-1 rather than 1..GetViewCount
          if Result <> -1 then
            Dec(Result);
          Break;
        end;
      end;
      WindowIterator := GetWindow(WindowIterator, GW_HWNDNEXT);
    end;
  end;
end;

{ TEventsEditorNotification }

procedure TEventsEditorNotification.AfterSave();
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);
    
end;

procedure TEventsEditorNotification.BeforeSave();
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);

end;

procedure TEventsEditorNotification.Destroyed();
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);
    
end;

procedure TEventsEditorNotification.Modified();
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);

end;

procedure TEventsEditorNotification.FileNotification(NotifyCode: TOTAFileNotification; const FileName: string; var Cancel: Boolean);
begin
  if (( NotifyCode = ofnActiveProjectChanged ) or ( NotifyCode = ofnFileClosing )) then
    begin
    if( Assigned(FOnCloseNotify)) then
      FOnCloseNotify( NIL );
      
    end

  else
    if (Assigned(FOnUpdateNotify)) then
      FOnUpdateNotify(NIL);

end;

procedure TEventsEditorNotification.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);

end;

procedure TEventsEditorNotification.AfterCompile(Succeeded: Boolean);
begin
  if (Assigned(FOnUpdateNotify)) then
    FOnUpdateNotify(NIL);

end;
{$ELSE}
function GetCurrentEditView(EditorIntf: TIEditorInterface): Integer;
var
  EditorFileName: string;
  WindowIterator: HWND;
  Buffer: array[0..255] of Char;
  APos: PChar;
begin
  Assert(EditorIntf <> nil);
  Result := -1;
  if EditorIntf.GetViewCount = 1 then
  begin