Пятница, 03.05.2024, 16:38
Приветствую Вас Гость
Меню сайта


Копилка для дальнейшего развития ресурса.
 
Форма входа
Интересное
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

Программирование на Delphi.

Программирование

Главная » 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; 
Var 
  sChecked: String; 
  i: Integer; 

begin 
  If FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') Then 
  Begin 
  // Считываем файл 
  CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); 
  i := 0; 
  While i < CheckListBoxRule.Items.Count Do 
  Begin 
  If CheckListBoxRule.Items[i] = '' Then 
  Begin 
  // Удаляем пустую ячейку 
  CheckListBoxRule.Items.Delete(i); 
  End 
  Else 
  Begin 
  // получаем состояние чекбокса 
  sChecked := Copy(CheckListBoxRule.Items[i], 1, 1); 
  CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2, Length(CheckListBoxRule.Items[i])); 
  // Обновляем свойство Checked 
  CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked)); 
  Inc(i); 
  End; 
  End; 
  End; 
end; 



 
Разместите на форму 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;


// Добавьте в описание формы:

type
  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;



// Способ первый

procedure TForm1.FormCreate(Sender: TObject);
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.