Добро пожаловать на Weter.Online
системный программист
// добавляем несколько строк в ваш 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.
// все очень просто, меняем свойство формы 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;
// в процедуру передается строка, которая посимвольно отправляется в компонент 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;
// напомню, константа VK_F12 находится в модуле Windows keybd_event(VK_F12, 0, KEYEVENTF_EXTENDEDKEY, 0); keybd_event(VK_F12, 0, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
// для этой цели как вариант можно использовать 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;
// готовая функция; можно использовать конструкции // 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;
// символ #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; // открываем запрос
// пишем функцию которая будет "готовить" 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;
// далее будем использовать полученные функции 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;
// будьте внимательны при удалении записи, по неосторожности можно очистить таблицу, // если к примеру в строке 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;