Приложение зависает при изменении окна. Раскладка клавиатуры. - PullRequest
Новая
       24

Приложение зависает при изменении окна. Раскладка клавиатуры.

4 голосов
/ 24 мая 2011

Приведенный ниже код останавливает приложение при изменении фокуса с Edit1 на Edit2 после создания потока.

Шаги для воспроизведения:

  • Нажмите кнопку Создать тему
  • Переключение фокуса между Edit1 / Edit2.

Я думаю, что создание объекта ADO внутри потока приводит к зависанию приложения.

Кто-нибудь имеет представление о том, в чем именно проблема?

Примечание. Думаю, проблема возникает при изменении языка ввода по умолчанию. Win xp - диалоговое окно Text Service и Input langauges - язык ввода по умолчанию.

Та же проблема, что и:

http://social.msdn.microsoft.com/Forums/en/vcgeneral/thread/1d27c2ad-7ef1-45e9-b9af-6bfb458c1165

pas file 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ADODB, SyncObjs, ActiveX,
  ComObj, Menus, StdCtrls;

type

  TMyThread = class(TThread)
  private
    FEvent : TEvent;
    adoConnection : TADOConnection;
  protected
    procedure Execute; override;
  public
    constructor Create(ASuspended : boolean);
    destructor Destroy; override;
  end;


  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure TextEdit1Enter(Sender: TObject);
    procedure TextEdit2Enter(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    MyThread : TMyThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create(ASuspended: boolean
                            );
begin
  inherited Create(ASuspended);
  FEvent := TEvent.Create(nil,
                          false,
                          false,
                          'test'
                          );
end;

destructor TMyThread.Destroy;
begin
  FreeAndNil(FEvent);
  inherited;
end;

procedure TMyThread.Execute;
begin
  CoInitializeEx(nil,
                 COINIT_MULTITHREADED
                );
  try
    adoConnection := TADOConnection.Create(nil);
    FEvent.WaitFor(INFINITE);
    adoConnection.Free;
  finally
    CoUnInitialize;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyThread.Resume;
end;

procedure TForm1.TextEdit1Enter(Sender: TObject);
begin
  LoadKeyboardLayout(PChar(IntToHex(1081, 8)), KLF_ACTIVATE);
end;

procedure TForm1.TextEdit2Enter(Sender: TObject);
begin
  LoadKeyboardLayout(PChar(IntToHex(1043, 8)), KLF_ACTIVATE);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MyThread.FEvent.SetEvent;
  MyThread.Terminate;
  FreeAndNil(MyThread);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyThread := TMyThread.Create(true);
end;

end.

файл формы 

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 115
  ClientWidth = 147
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Edit1: TEdit
    Left = 8
    Top = 8
    Width = 121
    Height = 21
    TabOrder = 0
    Text = 'Edit1'
    OnEnter = TextEdit1Enter
  end
  object Edit2: TEdit
    Left = 8
    Top = 35
    Width = 121
    Height = 21
    TabOrder = 1
    Text = 'Edit2'
    OnEnter = TextEdit2Enter
  end
  object Button1: TButton
    Left = 8
    Top = 62
    Width = 121
    Height = 45
    Caption = 'Create Thread'
    TabOrder = 2
    WordWrap = True
    OnClick = Button1Click
  end
end

1 Ответ

1 голос
/ 25 мая 2011

Решено.

В файле pas измените строку 

 CoInitializeEx(nil,
                 COINIT_MULTITHREADED
                );

на 

  CoInitializeEx(nil,
                 COINIT_APARTMENTTHREADED
                );

и 

  FEvent := TEvent.Create(nil,
                          false,
                          false,
                          'test'
                          );

на 

  FEvent := TEvent.Create(nil,
                          false,
                          false,
                          'test',
                          true
                          );
...