Суббота, 23.06.2018, 07:03
Приветствую Вас Гость
Меню сайта


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

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

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

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

Главная » FAQ » Разное

 
Uses Prints;

procedure PrintStrings(Strings: TStrings);
var
  Prn: TextFile;
  i: word;
begin
  AssignPrn(Prn);
  try
    Rewrite(Prn);
    try
      for i := 0 to Strings.Count - 1 do
        writeln(Prn, Strings.Strings[i]);
    finally
      CloseFile(Prn);
    end;
  except
    on EInOutError do
      MessageDlg('Error Printing text.', mtError, [mbOk], 0);
  end;
end;

Для вызова процедуры печате напишите: PrintStrings(Memo1.Lines) или PrintStrings(Listbox1.Items);



 
function IsValidEmail(const Value: string): boolean;
  function CheckAllowed(const s: string): boolean;
  var
    i: integer;
  begin
    Result:= false;
    for i:= 1 to Length(s) do
    begin
      { недопустимый символ в s - значит недопустимый адрес }
      if not (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) then
        Exit;
    end;
    Result:= true;
  end;
var
  i: integer;
  namePart, serverPart: string;
begin // начало выполнения IsValidEmail
  Result:= false;
  i:= Pos('@', Value);
  if i = 0 then
    Exit;
  namePart:= Copy(Value, 1, i - 1);
  serverPart:= Copy(Value, i + 1, Length(Value));
  // @ не указано имя         имя или сервер не указаны; минимально для сервера. "a.com"
  if (Length(namePart) = 0) or ((Length(serverPart) < 5)) then
    Exit;
  i:= Pos('.', serverPart);
  // должно иметь точку и как минимум три знака от конца
  if (i = 0) or (i > (Length(serverPart) - 2)) then
    Exit;
  Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;


 
Разместите на форму 2 компонента: ListBox и Edit. В событии Change у Edit напишите следующее:
 
procedure TForm1.Edit1Change(Sender: TObject);
begin
ListBox1.Perform(LB_SELECTSTRING,-1,longint(Pchar(Edit1.text)));
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.



// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
var
  KS: TKeyboardState;
begin
  GetKeyboardState( KS );
  if KS[020] and 1 = 1 then
  LabelCapsLock.Enabled := true
  else
  LabelCapsLock.Enabled := false;
  if KS[144] and 1 = 1 then
  LabelNumLock.Enabled := true
  else
  LabelNumLock.Enabled := false;
  if KS[145] and 1 = 1 then
  LabelScrollLock.Enabled := true
  else
  LabelScrollLock.Enabled := false;
  SetKeyboardState( KS );
end;



1-5 6-6