Исходники на Delphi

Как сделать простой запрет на повторный запуск программы


	 // добавляем несколько строк в ваш DPR файл
	 var h: THandle;
	 begin
	  h := FindWindow('TForm1', nil);
	  if h <> 0 then begin // программа загружена
		ShowWindow(h, SW_MAXIMIZE);
		SetForegroundWindow(h);
		Halt;
		end;
	  Application.Initialize;
	  Application.CreateForm(TForm1, Form1);
	  Application.Run;
	 end.
	

Как сделать перемещение по полям ввода при нажатии клавиши Enter


	 // все очень просто, меняем свойство формы KeyPreview := True
	 // и пишем в обработчике FormKeyDown всего одну строчку
	 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
	 begin
	   if Key = VK_RETURN then SendMessage(Handle, WM_NEXTDLGCTL, 0, 0);
	 end;
	

Как сделать "правильный" ввод русских Фамилий, Имен, Отчеств в полях ввода


	// здесь (Sender as TEdit) то же самое как Edit1, а это значит, что
	// этот обработчик можно присвоить нескольким компонентам TEdit
	procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
	begin
	 case Key of
		'А'..'Я','а'..'я','-',#8: begin
			if (Sender as TEdit).SelStart = 0
				then Key := AnsiUpperCase(String(Key))[1]
				else Key := AnsiLowerCase(String(Key))[1];
		end;
	  else Key := #0;
	  end;
	end;
	

Как сделать быструю очистку всех полей ввода


	// пробегаем по всем компонентам формы
	var i: integer;
	begin
	  for i := 0 to ComponentCount - 1 do begin
		  if (Components[i] is TEdit)     then (Components[i] as TEdit).Clear;
		  if (Components[i] is TComboBox) then (Components[i] as TComboBox).ItemIndex := -1;
		  end;
	end;
	

Как посимвольно напечатать строку в текущей позиции в Memo


	// в процедуру передается строка, которая посимвольно отправляется в компонент Memo1 
	procedure PasteStr(s: string);
	var i: integer;
	begin
	 for i := 1 to Length(s) do SendMessage(Form1.Memo1.Handle, WM_CHAR, Ord(s[i]), 0);
	end;
	

Как программно нажать клавишу, например на F12


	// напомню, константа VK_F12 находится в модуле Windows
	 keybd_event(VK_F12, 0, KEYEVENTF_EXTENDEDKEY, 0);
	 keybd_event(VK_F12, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
	

Как конвертировать текстовый файл из DOS в WIN или из WIN в DOS


	// для этой цели как вариант можно использовать CharToOem() или OemToChar()
	// sfile - источник, dfile - приемник
	// вызывается процедура так FileCharToOem('c:\1.txt', 'c:\2.txt');
	// при этом 1.txt должен быть на диске, а 2.txt создается процедурой,
	// пример без проверок на возможные форс-мажоры!
	procedure FileCharToOem(sfile, dfile: string);
	var sf, df: TextFile; s: string;
	begin
	 AssignFile(sf, sfile);
	 AssignFile(df, dfile);
	 Reset(sf);
	 Rewrite(df);
	 while not Eof(sf) do begin
	   ReadLn(sf, s);
	   CharToOem(Pchar(s), Pchar(s)); // конструкция "безопасная", так как длина одинаковая
	   WriteLn(df, s);
	   end;
	 CloseFile(sf);
	 CloseFile(df);
	end;
	

Как правильно динамически подключить библиотеку и вызвать функцию


	// тип RunFunc - что то вроде шаблона нашей функции
	// библиотека Calc.dll будет рассмотрена в следующем примере
	// в качестве Int1, Int2, Int3: TSpinEdit к примеру
	procedure TForm1.Button1Click(Sender: TObject);
	type RunFunc = function(a, b: integer): integer; stdcall;
	var hLib: HMODULE;                              // указатель на DLL
		rFunc: RunFunc;                             // функция в DLL
	begin
	 hLib := LoadLibrary('Calc.dll');               // загрузка
	 if hLib = 0 then begin                         // если не найдена библиотека
		ShowMessage('Не найдена библиотека "Calc.dll"');
		Exit;
		end;
	 rFunc := GetProcAddress(hLib, 'Summa');        // "поиск" функции в DLL
	 if not Assigned(rFunc) then begin              // если не найдена функция
		ShowMessage('Не найдена функция "Summa"');
		FreeLibrary(hLib);
		Exit;
		end;
	 Int3.Value := rFunc(Int1.Value, Int2.Value);   // использование
	 FreeLibrary(hLib);                             // свобода указателю
	end;
	

Как пишутся динамические библиотеки


	// в библиотеке может быть множество процедур и функций,
	// много подключенных модулей и даже полнофункциональные Delphi формы;
	// не пугайтесь, в этом примере использована ассемблерная вставка 
	library Calc;
	// uses SysUtils, Classes;  // рекомендуется, но в данном примере можно не использовать,
								
	function Summa(a, b: integer): integer; stdcall; export;
	begin
	 asm              //  можно заменить на Result := a + b;
	 mov eax, a
	 add eax, b
	 mov Result, eax
	 end;             // ---
	end;

	exports
	 Summa index 1;

	begin
	end.
	

Как сохранить положение окна в реестре


	// не забываем подключить Uses Registry;
	procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
	var Reg: TRegistry;
	begin
	 Reg := TRegistry.Create;
	 Reg.RootKey := HKEY_LOCAL_MACHINE;
	 Reg.OpenKey('\SOFTWARE\Weter\Test', True); // True - создаст, если нет такого ключа
	 Reg.WriteInteger('Left', Left);
	 Reg.WriteInteger('Top', Top);
	 Reg.WriteInteger('Width', Width);
	 Reg.WriteInteger('Height', Height);
	 Reg.CloseKey;
	 Reg.Free;
	end;
	

Как прочитать положение окна из реестра


	// не забываем подключить Uses Registry;
	// код не защищен от форс-мажора
	procedure TForm1.FormCreate(Sender: TObject);
	var Reg: TRegistry;
	begin
	 Reg := TRegistry.Create;
	 Reg.RootKey := HKEY_LOCAL_MACHINE;
	 Reg.OpenKey('\SOFTWARE\Weter\Test', false);
	 Left   := Reg.ReadInteger('Left');
	 Top    := Reg.ReadInteger('Top');
	 Height := Reg.ReadInteger('Height');
	 Width  := Reg.ReadInteger('Width');
	 Reg.CloseKey;
	 Reg.Free;
	end;
	

Посимвольная конвертация строки из формата DOS в WIN


	// готовая функция; можно использовать конструкции
	// if      ord(s[i]) in [127..176]  then begin end;
	// if not (ord(s[i]) in [223..240]) then begin end;
	// кому как больше нравится 
	function DosToWin(s: string): string;
	var i: Integer;
	begin
	 for i := 1 to Length(s) do begin
	   if (ord(s[i]) > 127) and (ord(s[i]) < 176) then begin
		  s[i] := chr(ord(s[i]) + 64);
		  end else begin
		  if (ord(s[i]) > 223) and (ord(s[i]) < 240) then
			 s[i] := chr(ord(s[i])+16);
		  end;
	   end;
	 Result := s;
	end;
	

Как выбрать записи из таблицы с помощью TQuery


	 // символ #39 - тоже самое как одинарная (') ковычка
	 Query1.SQL.Clear;
	 Query1.SQL.Add('SELECT LS, FIO FROM KLIENT');   // выбираем столбцы LS, FIO из таблицы KLIENT
	 Query1.SQL.Add('WHERE FIO LIKE '#39'%ван%'#39); // при условии если FIO содержит 'ван'
	 Query1.SQL.Add('ORDER BY LS');                  // сортируем по столбцу LS
	 Query1.Open;                                    // открываем запрос
	

Как заменить малопонятную #39


	 // пишем функцию которая будет "готовить" String к запросам
	 function sSQL(s: string): string;
	 begin
	  Result := #39 + s + #39;
	 end;

	 // для Integer функфия будет выглядеть иначе
	 function iSQL(i: integer): string;
	 begin
	  Result := #39 + IntToStr(i) + #39; // На некоторых платформах (') ковычка не используется
	 end;

	  // для TDate функфия будет выглядеть так
	 function dSQL(d: TDate): string;
	 begin
	  Result := #39 + FormatDateTime('dd.mm.yyyy', d) + #39;
	 end;

	 // ------
	 // теперь предидущий пример будет выглядеть так
	 Query1.SQL.Clear;
	 Query1.SQL.Add('SELECT LS, FIO FROM KLIENT');
	 Query1.SQL.Add('WHERE FIO LIKE ' + sSQL('%ван%')); 
	 Query1.SQL.Add('ORDER BY LS');
	 Query1.Open;
	

Как добавить новую запись в таблицу с помощью SQL


	 // далее будем использовать полученные функции sSQL, iSQl, dSQL
	 Query1.SQL.Clear;
	 Query1.SQL.Add('INSERT INTO KLIENT');
	 Query1.SQL.Add('(LS, FIO, DATREG)');
	 Query1.SQL.Add('VALUES('+iSQL(4)                       +
				 ', '+sSQL('Дроздов Н.Н.')          +
				 ', '+dSQL(StrToDate('11.01.2009')) + ')');
	 Query1.ExecSQL;
	

Как удалить запись из таблицы с помощью SQL


	 // будьте внимательны при удалении записи, по неосторожности можно очистить таблицу,
	 // если к примеру в строке WHERE произойдет форс-мажор и она не будет добавлена
	 // вот и еще один плюс использования iSQL (не путать с interactive SQL)
	 // чуть позже будут рассмотрены безопасные конструкции при работе с DELETE и UPDATE
	 Query1.SQL.Clear;
	 Query1.SQL.Add('DELETE FROM KLIENT');
	 Query1.SQL.Add('WHERE LS=' + iSQL(3) );  // удаляем запись с лицевым счетом 3
	 Query1.ExecSQL;
	
Copyright © Weter Soft г.Нижнекамск 2017