Программирование
Главная » FAQ |
Procedure TFrameRuleEngine.SaveRules; Var i: Integer; begin i := 0; While i < CheckListBoxRule.Items.Count Do Begin If CheckListBoxRule.Items[i] = '' Then Begin // Если ячейка пустая, то удаляем её CheckListBoxRule.Items.Delete(i); End Else Begin // Добавляем 1 или 0 соответственно checked или not checked CheckListBoxRule.Items[i] := IntToStr(Integer(CheckListBoxRule.Checked[i])) + CheckListBoxRule.Items[i]; Inc(i); End; End; // Сохраняем весь список CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); end; Procedure TFrameRuleEngine.LoadRules; |
Разместите на форму 2 компонента: ListBox и Edit. В событии Change у Edit напишите следующее:
procedure TForm1.Edit1Change(Sender: TObject); begin ListBox1.Perform(LB_SELECTSTRING,-1,longint(Pchar(Edit1.text))); end; |
Это может быть ни только панель, но и любой другой компонен. В обработчике событий OnMouseDown пишем:
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:Integer);
begin ReleaseCapture
Sendmessage(Form1.Handle,wm_syscommand,$F012,0); end; |
// Добавьте в описание формы: TMain = class(TForm) .... protected procedure WMGetSysCommand( var Message: TMessage ); message WM_SYSCOMMAND; end; ..... // Обработка сообщения WM_SYSCOMMAND // перехват минимизации окна procedure TForm1.WMGetSysCommand( var Message: TMessage ); begin if ( Message.wParam = SC_MINIMIZE ) then form1.Visible := False else inherited; end; |
// Способ первый var Wnd : HWND; begin Wnd := CreateMutex( nil, true , PChar( Application.title ) ); if GetLastError = ERROR_ALREADY_EXISTS then begin CloseHandle( Wnd ); Application.Terminate; end; end; // Способ второй procedure TForm1.FormCreate(Sender: TObject); var Wnd: hWnd; buff: array [0..127] of char; begin Wnd := GetWindow( Handle, gw_HWndFirst ); while Wnd <> 0 do begin // Если не собственное и не дочернее окно if ( Wnd <> Application.Handle ) and ( GetWindow( Wnd, gw_Owner ) = 0 ) then begin GetWindowText( Wnd, buff, sizeof( buff ) ); // Если заголовок совпадает, то... if StrPas( buff ) = Application.Title then // Поторный запуск begin // Действие при повторном запуске CloseHandle( Wnd ); Application.Terminate; end; end; Wnd := GetWindow( Wnd, gw_hWndNext ); end; end; // Способ третий // Приведите файл *.dpr к следующему виду program Project1; uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} var HWND: THandle; function Check: boolean; begin HWND := OpenMutex( MUTEX_ALL_ACCESS, false, 'MyOwnMutex' ); Result := ( HWND <> 0 ); if HWND = 0 then HWND := CreateMutex( nil, false, 'MyOwnMutex' ); end; begin if Check then Exit; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. // Способ четвертый // Приведите файл *.dpr к следующему виду program Project1; uses Forms, SyncObjs, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} var CheckEvent: TEvent; begin CheckEvent:= TEvent.Create( nil, false, true, 'MYPROGRAM_CHECKEXIST' ); if CheckEvent.WaitFor( 10 ) <> wrSignaled then Exit; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. // Способ пятый // Необходимо быть уверенным, что в системе больше нет окон с именем "TForm1" // Приведите файл *.dpr к следующему виду program Project1; uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} var hwnd: THandle; begin hwnd := FindWindow( 'TForm1', 'Form1' ); if hwnd = 0 then begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end else SetForegroundWindow( hwnd ); end. // Способ шестой // Приведите файл *.dpr к следующему виду program Project1; uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} const MemFileSize = 127; MemFileName = 'one_example'; var MemHnd: HWND; begin MemHnd := CreateFileMapping( HWND( $FFFFFFFF ), nil, PAGE_READWRITE, 0, MemFileSize, MemFileName); if GetLastError <> ERROR_ALREADY_EXISTS then begin Application.Initialize; with TForm1.Create( nil ) do try Show; Update; Application.CreateForm(TForm1, Form1); finally Free; end; Application.Run; end else Application.MessageBox( 'Приложение уже запущено', 'Производственно-диспетчерская служба', MB_OK ); CloseHandle( MemHnd ); end. |