Секреты Delphi. Менеджер памяти

Я думаю, ни для кого не секрет, что некоторый запас свободной оперативной памяти для работы приложений влияет на производительность. Оптимизировать процесс распределения памяти между программами можно установкой специальных сервисов, которые периодически сбрасывают часть данных в своп-файл. Особенно это актуально на компьютерах с небольшим объемом оперативной памяти.

В процессе решения этой проблемы я попытался создать модуль освобождения оперативной памяти, который вызывался бы с некоторой периодичностью или перед выполнением длительных, ресурсоемких операций. Отсутствие информации по работе стандартного менеджера привело к следующему выводу: нужно попытаться выделить достаточно большой участок памяти под какой-нибудь объект, а затем освободить его. При этом менеджер памяти Windows сбрасывает часть данных в своп.
Пример функции, реализующей данный алгоритм:


function BS_FreeMem(const aBuf Size: Integer):boolean;  
var  
tmpBuffer: PChar;  
begin  
result:=true;  
try  
//Выделяем буфер заданного размера  
GetMem(tmpBuffer, aBufSize);  
try  
//Заполняем буфер нулями для имитации его использования  
FillChar(tmpBuffer^, aBufSize, 0);   
finally  
FreeMem(tmpBuffer);  
end;  
except  
result:=false;  
end;  
end;  

На машинах класса Windows NT можно попробовать воспользоваться API-функцией SetProcessWorkingSetSize.
Вызов данной функции со значениями параметров dwMinimumWorkingSetSize и dwMaximumWorkingSetSize, равными $FFFFFFFF, вызывает сброс страниц памяти, занятых процессом, в своп-файл. Например:


SetProcessWorkingSetSize (GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);  

Вызывать созданную фунцию можно по таймеру, например:


procedure TfrmMain.Digital ClockMinute (Sender: TObject; DDGTime: TDateTime);  
var  
MemStat:TMemoryStatus;  
fMemPercent:Extended;  
bufSize:Variant;  
oldHint:String;  
oldCursor:TCursor;  
begin  
//Глобальная переменная, определяющая активность функции  
if gInternalMemManager then  
begin  
MemStat.dwLength := SizeOf (TMemory Status);  
GlobalMemoryStatus(Mem Stat);  
fMemPercent:=(MemStat.dw TotalPhys-MemStat.dwAvailPhys);  
fMemPercent:=fMemPercent* 100/MemStat. dwTotalPhys;  
//Вызываем функцию, при загрузке памяти более 90%  
if fMemPercent > 90 then  
try  
oldHint:=Application. Hint;  
oldCursor:=Screen. Cursor;  
Screen.Cursor:=crHour Glass;  
Application.Hint:='Освобождение оперативной памяти..';  
//вычисляем размер выделяемого буфера  
bufSize:=(MemStat.dwTo-talPhys-MemStat.dwAvailPhys)/2;  
BS_FreeMem(Integer (buf Size));  
finally  
Application.Hint:=oldHint;  
Screen.Cursor:=oldCursor;  
end;  
end;   
end; 

Следует заметить, что на 100% проблема не решается, так как на освобождение памяти требуется некоторое время, и вызов функции освобождения памяти может произойти в неподходящий момент — например, когда пользователь вводит данные и не смотрит на экран. Буду признателен за возможные идеи решения поставленной задачи.

Автор: Сергей Бердачук

Добавлено: 02 Августа 2018 07:40:57 Добавил: Андрей Ковальчук

Преврашаем shape в мяч

В этом уроке я покажу вам как с легкостью сделать летающий шарик у себя на форме. Ну что открываем Delphi, создаем новый проект. Нам понадобиться компонент Shape с закладки Additional и компонент Timer с закладки System. Кидаем их на форму, щелкаем по компоненту shape и меняем свойство shape на ctCircle теперь вместо квадрата компонент примет форму круга. Все на этом предварительные приготовления завершены начинаем кодить.

После ключевого слова var обьявлем 4 глобальные переменные типа single


PosX, Posy, VelX, Vely: single;   

Создаем обработчик событий на форме (OnCreate) прост щелкнув по ней 2 раза мышкой. Между begin end; пишем:


Posx:=3;  
PosY:=5;  
VelX:=2;  
VelY:=2;   

На данном этапе мы присваиваем ранее объявленным переменным нужные значения.

Далее нам понадобиться создать одну не большую процедуру. После ключевого слова private пишем


procedure shar();  

Нажимаем сочетание клавиш Ctrl+Shift+C и Delphi автоматически сгенерирует заготовку для нашей будущей процедуры. Забегая вперед открою вам не большой секрет, именно эта процедура и будет отвечать за полет шарика. Ладно немного отвлеклись, вставляем ниже приведенный код между словами begin end в нашей процедуре.


// Текущая координата шарика + скорость  
PosX:= PosX+VelX;  
PosY:= PosY+VelY;  
  
// Что бы шарик не вылетал за границы поля по ширине  
// Если X координата шарика больше ширины формы - ширины самого //шарика то  
if PosX > ClientWidth - Shape1.Width then  
begin  
//X координата шарика присвоит значение ширина формы - ширина //шарика  
PosX:= ClientWidth - Shape1.Width;  
// Включаем заднюю скорость) или меняем значение скорости на минус  
VelX:= - VelX;  
end  
else if PosX < 0 then  
begin  
POsX:= 0;  
VelX:= - VelX;  
end;  
  
// Здесь по аналогии только работаем с Y координатой  
if PosY > ClientHeight - Shape1.Width then  
begin  
POsY:= ClientHeight - Shape1.Width;  
VelY:= - VelY;  
end  
else if PosY < 0 then  
begin  
POsY:= 0;  
VelY:= - VelY;  
end;  
// Перемещаем шарик в пространстве  
Shape1.Left:= Round(PosX);  
Shape1.Top:= Round(PosY);  

Сейчас не стоит пугаться процедура не такая уж сложная как кажется на первый взгляд. Если кто не понял что в ней происходит читайте комментарии в коде. Кратко поясню что-же за переменные использованы в процедуре

Переменные PosX и PosY хранят координаты положение шарика в пространстве, VelX и VelY отвечают за скорость его перемещения. ClientWidth, ClientHeight - ширина и высота формы. Shape1.Width ширина шарика.

Ну что справились с процедурой ?! Ладно едим дальше свойство Interval у таймера ставим 10, а свойство Enabled = true. Кликаем по компоненту timer два раза и в обработчике событий пишем имя нашей процедуры


shar;

На этом все, запускаем проект и наслаждаемся результатом.

Добавлено: 02 Августа 2018 07:40:11 Добавил: Андрей Ковальчук

Работаем с файлами

Сейчас я хочу показать вам, как в Delphi работать с файлами (изменять, удалять, копировать, переименовывать), ниже будет представлен исходник программы и если у вас что-то не получиться запрограммировать, то вы всегда сможете посмотреть этот исходник.

Копирование файлов в Delphi
За копирование файлов в Delphi отвечает функция CopyFile, она имеет следующий синтаксис:


CopyFile(Начальный_файл, Конечный_файл, Перезапись);  

Где,
Начальный_файл - Полный путь с указанием имени и расширения к файлу, который будет копироваться.
Конечный_файл - Полный путь с указанием имени и расширения куда копируем.
Перезапись – Если такой файл уже существует, то будет ли он перезаписан (true - не будет, false - будет).

Пример:


CopyFile('C:\1.txt', 'D:\1.txt', true);  

Обратите внимание, что при указании второго параметра (Конечный_файл) мы указываем не просто папку куда хотим скопировать файл, но и еще желаемое имя с расширение файла. Т.е если Начальный файл c:\1.txt, то если указать имя конечного файла как d:\1Copy.txt то в процессе копирования наш 1.txt переименуется в 1Copy.txt.

Переименование файлов в Delphi
За переименование файлов в Delphi отвечает функция RenameFileсинтаксис у неё очень простой и чем то схож с функцией копирования.


RenameFile('Начальное_имя','Конечное_имя') 

Начальное_имя - Полный путь с указанием имени и расширения, к файлу, который будет переименован.
Конечное_имя - Полный путь к файлу с указанием нового имени и расширения.

Пример:


RenameFile('c:\1.txt','c:\1Rename.txt');  

Перемещение файлов в Delphi
Что бы переместить файл, в Delphi используется функция MoveFile. Давайте посмотрим на её синтаксис:


MoveFile(Начальный_файл, Конечный_файл); 

Где,
Начальный_файл - Полный путь с указанием имени и расширения к файлу, который будет перемещаться.
Конечный_файл - Полный путь с указанием имени и расширения куда перемещаем.

Здесь также следует обратить внимание на то что при указании второго параметра (Конечный_файл) мы указываем не просто папку куда хотим переместить файл, но и еще желаемое имя с расширение файла. Т.е если Начальный файл c:\1.txt, то если указать имя конечного файла как d:\1Paste.txt то в процессе перемещения наш 1.txt переименуется в 1Paste.txt.

Удаление файлов в Delphi
Наверное, самая простая из рассмотренных выше функций это функция удаления, DeleteFile.


DeleteFile('Имя_файла');  

Имя_файла - здесь предполагается указание полного пути, имени и расширения удаляемого файла.

Пример:


DeleteFile('c:\1.txt');  

Добавлено: 02 Августа 2018 07:38:41 Добавил: Андрей Ковальчук

Отлавливаем нажатие калавиш клавиатуры

В этом коротком уроке я покажу вам, как перехватывать нажатия кнопок клавиатуры. Пригодиться он для написания простенького клавиатурного шпиона, который бы отлавливал нажатия клавиш и вёл лог. Можно написать просто небольшой прикол типа если пользователь нажимает клавишу "Ф" то на экране появляется "И". Короче я думаю фантазия у вас работает нормально поэтому применение этому коду вы найдете.

Начинаем кодить, нам понадобиться: Компонент Timer с закладки System и компонент Label с закладки Standart. Выделяем Timer, создаем, обработчик событий OnTime и прописываем в нем следующий код:


if getasynckeystate($1b)<>0 then  
Label1.Caption:='Вы нажали ESC' 

Вот что должно получиться:


procedure TForm1.Timer1Timer(Sender: TObject);  
begin  
if getasynckeystate($1b)<>0 then  
Label1.Caption:='Вы нажали ESC'  
end;  

В данном примере мы перехватываем нажатие клавиши ESC во всем Windows и побарабану активна или нет наша программа. Используем мы здесь Api функцию getasynckeystate, в качестве параметра ей нужно указать виртуальный код клавиши, котрую хотим отлавливать. В нашем случае это Esc виртуальный код $1b. Все виртуальные коды клавиш приведены ниже:

Да чуть не забыл, свойство Interval у компонента Timer меняем на 1


vk_lbutton = $01;  
vk_rbutton = $02;  
vk_cancel = $03;  
vk_mbutton = $04;  
vk_back = $08;  
vk_tab = $09;  
vk_clear = $0c;  
vk_return = $0d;  
vk_shift = $10;  
vk_control = $11;  
vk_menu = $12;  
vk_pause = $13;  
vk_capital = $14;  
vk_escape = $1b;  
vk_space = $20;  
vk_prior = $21;  
vk_next = $22;  
vk_end = $23;  
vk_home = $24;  
vk_left = $25;  
vk_up = $26;  
vk_right = $27;  
vk_down = $28;  
vk_select = $29;  
vk_print = $2a;  
vk_execute = $2b;  
vk_snapshot = $2c;  
vk_insert = $2d;  
vk_delete = $2e;  
vk_help = $2f;  
>> vk_a - vk_z такие же, как и их ascii-эквиваленты: 'a' - 'z' ($41 - $5A)<<
>> vk_0 - vk_9 такие же, как и их ascii-эквиваленты: '0' - '9' ($30 - $39)}


vk_numpad0 = $60;  
vk_numpad1 = $61;  
vk_numpad2 = $62;  
vk_numpad3 = $63;  
vk_numpad4 = $64;  
vk_numpad5 = $65;  
vk_numpad6 = $66;  
vk_numpad7 = $67;  
vk_numpad8 = $68;  
vk_numpad9 = $69;  
vk_multiply = $6a;  
vk_add = $6b;  
vk_separator = $6c;  
vk_subtract = $6d;  
vk_decimal = $6e;  
vk_divide = $6f;  
vk_f1 = $70;  
vk_f2 = $71;  
vk_f3 = $72;  
vk_f4 = $73;  
vk_f5 = $74;  
vk_f6 = $75;  
vk_f7 = $76;  
vk_f8 = $77;  
vk_f9 = $78;  
vk_f10 = $79;  
vk_f11 = $7a;  
vk_f12 = $7b;  
vk_f13 = $7c;  
vk_f14 = $7d;  
vk_f15 = $7e;  
vk_f16 = $7f;  
vk_f17 = $80;  
vk_f18 = $81;  
vk_f19 = $82;  
vk_f20 = $83;  
vk_f21 = $84;  
vk_f22 = $85;  
vk_f23 = $86;  
vk_f24 = $87;  
vk_numlock = $90;  
vk_scroll = $91;  

Добавлено: 02 Августа 2018 07:37:00 Добавил: Андрей Ковальчук

Русификация компонента TRichEdit

Для того, чтобы компонент TRichEdit сохранял символы национальных алфавитов в их натуральном виде, а не в виде шестнадцатиричных кодов, необходимо создать специальный конвертор и зарегистрировать его в компоненте. Конвертор наследуется от класса TConversion, в котором определены два виртуальных метода ConvertReadStream и ConvertWriteStream, которые отвечают за преобразование потока символов соответственно при чтении и записи файла. Чтение файла, содержащего русские символы, происходит корректно и без применения специальных мер, поэтому мы должны перекрыть только метод записи. В перекрытом методе необходимо разместить код, преобразующий шестнадцатиричные коды в символы русского алфавита. Ниже приведен пример русификации (redMain - компонент типа TRichEdit).


type  
  // Объявляем класс конвертора.  
  TRussianConvertor=class(TConversion)  
    // Перекрываем только метод записи в поток.  
    function ConvertWriteStream(Stream: TStream; Buffer: PChar;  
      BufSize: Integer): Integer; override;  
  end;  
  
// Реализация метода записи в поток.  
function TRussianConvertor.ConvertWriteStream(Stream: TStream;   
  Buffer: PChar; BufSize: Integer): Integer;  
  
type  
  // Тип, упрощающий анализ потока символов.  
  TFourChars = record  
    HexTag,HexCode: array[0..1] of Char;  
  end;  
  PFourChars=^TFourChars;  
  
var  
  RusBuffer: PChar;  
  i,RusSize: Integer;  
  
  // Функция, преобразующая двухсимвольное  
  // Hex-представление в символ.  
  function HexToChar(Hex: PChar): Char;  
  
    function HexNumber(C: Char): Integer;  
    begin  
      C:=UpCase(C);  
      case C of  
        '0'..'9': Result:=Ord(C)-Ord('0');  
        'A'..'F': Result:=Ord(C)-Ord('A')+10;  
      else Result:=0;  
      end;  
    end;  
  
  begin  
    Result:=Chr(HexNumber(Hex[0])*16+HexNumber(Hex[1]));  
  end;  
  
begin  
  RusBuffer:=StrAlloc(BufSize);  
  RusSize:=0;  
  i:=0;  
  // Цикл по всем символам.  
  while i<BufSize do  
  begin  
    with PFourChars(@Buffer[i])^ do  
      // Hex-представление символа.  
      if HexTag='\''' then  
      begin  
        RusBuffer[RusSize]:=HexToChar(HexCode);  
        Inc(i,4);  
      end  
      else  
      // Все остальные случаи.  
      begin  
        RusBuffer[RusSize]:=Buffer[i];  
        Inc(i);  
      end;  
    Inc(RusSize);  
  end;  
  // Запись нового буфера в поток.  
  Result:=Stream.Write(RusBuffer^,Pred(RusSize));  
  StrDispose(RusBuffer);  
end;  
  
procedure TfrmMain.FormCreate(Sender: TObject);  
begin  
  // Регистрация конвертора для расширения rft.  
  redMain.RegisterConversionFormat('rtf',TRussianConvertor);  
end; 

По аналогичному принципу может быть построен, например, конвертор, позволяющий загружать и сохранять файлы в формате Microsoft Word.

Добавлено: 02 Августа 2018 07:35:55 Добавил: Андрей Ковальчук

Создание приложения в Дельфи, увеличивающее часть рабочего стола наподобие лупы

Есть программы, которые позволяют увеличивать определённую область экрана в районе курсора мышки. А вам слабо самостоятельно сделать такое приложение ?

Итак, приступим.

Нам понадобится одна форма, один элемент управления image, одна панель, кнопка, таймер и бегунок. Добавляем к форме картинку и панель. Размещаем остальные элементы управления на панели. Теперь всё готово к программированию. Но предварительно Вам необходимо изменить некоторые свойства у Ваших элементов управления.

А вот код, наиболее важной части программы:


// переменные  
var Srect,Drect,PosForme:TRect;  
    iWidth,iHeight,DmX,DmY:Integer;  
    iTmpX,iTmpY:Real;  
    C:TCanvas;  
    Kursor:TPoint;  
// Увеличиваем экран, если приложение не свёрнуто в иконку  
If not IsIconic(Application.Handle) then begin  
// Получаем координаты курсора  
  GetCursorPos(Kursor);  
  
// PosForm представляет прямоугольник с  
// координатами Form (image control).  
  PosForme:=Rect(Form1.Left,  
                 Form1.Top,  
                 Form1.Left+Form1.Width,  
                 Form1.Top+Form1.Height);  
  
//Показываем magnified screen   
//если курсор за пределами формы.  
  If not PtInRect(PosForme,Kursor) then begin  
  
// Далее код можно использовать для увеличения выбранной  
// части экрана. С небольшими модификациями его можно  
// использовать для уменьшения  
// экрана  
  iWidth:=Image1.Width;  
  iHeight:=Image1.Height;  
  Drect:=Bounds(0,0,iWidth,iHeight);  
  iTmpX:=iWidth / (Slider.Position * 4);  
  iTmpY:=iHeight / (Slider.Position * 4);  
  Srect:=  
  
   Rect(Kursor.x,Kursor.y,Kursor.x,Kursor.y);  
  InflateRect(Srect,Round(iTmpX),Round(iTmpY));  
  
//Получаем обработчик(handle) окна рабочего стола.  
  C:=TCanvas.Create;  
  try  
   C.Handle:=GetDC(GetDesktopWindow);  
//Передаём часть изображения окна в TImage.  
   Image1.Canvas.CopyRect(Drect,C,Srect);  
  finally  
   C.Free;  
  end;  
  
  end;  
  
// Обязательно обрабатываем все сообщения Windows.  
  Application.ProcessMessages;  
  
end; // IsIconic  

И напоследок, пара полезных компонент:

TransitionEffect. Компонент позволяет делать stretches, slides, zooms и pushes.
ZImage бесплатный Delphi VCL компонент, который можно использовать для отображения различных изображений: картинок, факсов и т.д. Используя мышку, можно увеличивать изображение и уменьшать, а так же скроллировать. Можно показывать скроллинг справа и внизу.

Добавлено: 02 Августа 2018 07:34:51 Добавил: Андрей Ковальчук

Работа с буфером обмена

Каждый юзер наверняка сталкивался с помещением информации в буфер и извлечением ее оттуда. Тот же пресловутый Ворд при нажатии кнопки "копировать" помещает выделенный текст в буфер, а при нажатии "вставить" - извлекает его. Таким же образом помещаться в буфер могут изображения и данные разных форматов. Итак, буфер - это специальная область оперативной памяти в которую Windows помещает пользовательские данные для обмена между разными приложениями или внутри одного приложения.

Для того, чтобы работать с буфером обмена из Delphi, необходимо подключить к своему приложению модуль clipbrd.pas, то есть пишем в uses clipbrd.pas,...

РАБОТА С ТЕКСТОМ
Самый простой способ поместить в буфер обмена какой-либо текст - это добавить следующий код:


Clipboard.asText:='ВАШ_ТЕКСТ'; 

или


Clipboard.SetTextBuf(PChar('ВАШ_ТЕКСТ'));  

Чтобы извлечь текст из буфера, можно сделать так (поместим текст в Memo1:TMemo):


Memo1.Text:=Clipboard.asText;  

РАБОТА С ИЗОБРАЖЕНИЯМИ
Если вы работаете с компонентом Image1:Timage, то самым простым способом поместить в него изображение из буфера будет присвоение хэндла данных Clipboard'a хэндлу Tbitmap:


Image1.Picture.Bitmap.Handle:=Clipboard.GetAsHandle(CF_bitmap); 

КАК УЗНАТЬ ФОРМАТ ДАННЫХ БУФЕРА В ДАННЫЙ МОМЕНТ
Для этого существует специальная функция Clipboard.HasFormat(Format: WORD):boolean;
Функция возвращает true, если в буфере именно этот формат, в противном случает возвращает false.
Описание форматов:
CF_TEXT - Обычный текст, заканчивающийся <CR><LF>
CF_BITMAP - Битмап изображение *.bmp
CF_METAFILEPICT - Метафайл изображение *.wmf
CF_PICTURE - Объект типа TPicture
CF_COMPONENT - Компонента Delphi (Tbutton, например)
CF_OBJECT - Любой объект в Delphi типа TPersistent

ОЧИЩАЕМ БУФЕР
Чтобы очистить буфер обмена от содержащихся в нем данных, используйте процедуру Clipboard.clear;
ОТКРЫВАЕМ // ЗАКРЫВАЕМ
Если вы хотите, чтобы все приложения, кроме вашего не могли изменять содержимое буфера, используйте


Clipboard.Open;  

После пользования буфером, его необходимо закрывать процедурой Clipboard.Close;

З.Ы.
Многие объекты в Delphi изначально имеют методы, позволяющие помещать данные в буфер и извлекать их оттуда, примером может служить Tpicture.

Удачного кодинга!

Добавлено: 02 Августа 2018 07:34:00 Добавил: Андрей Ковальчук

Как изменить иконку у директории?

Обычно для изменения вида папок в Проводнике используется файл desktop.ini.

Сперва необходимо создать файл desktop.ini и поместить его в ту директорию, иконку которой мы хотим изменить. В программе для этого можно воспользоваться классом TIniFile и передать в него путь директории.

Теперь нам необходимо записать в .ini-файл пары значений. В desktop.ini эти пары выглядят следующим образом:


[.ShellCLassInfo]   
IconFile=C:\folder.ico   
IconIndex=0   
InfoTip=Folder info tip  

Самое главное - это указать иконку и её индекс.

Значение IconFile - это путь к .dll, .ico, или .exe файлу. В Delphi это выглядит так:


var iniFile: TIniFile;   
...   
iniFile:=TIniFile.Create(edFolderPath.Text);   
with iniFile do   
  begin   
    //Следующие строки записывают в desktop.ini все необходимые параметры   
    WriteString('.ShellClassInfo', 'IconFile',  editIconPath.Text);   
    WriteString('.ShellClassInfo', 'IconIndex', editIconIndex.Text);   
    WriteString('.ShellClassInfo', 'InfoTip',editInfoTip.Text);   
    UpdateFile;   
  end;   
iniFile.Free;  

Примечание: здесь editFolderPath, editIconPath, editIconIndex и editInfoTip - элементы TEdit, в которые вводятся все необходимые данные - путь к директории, иконку которой следует изменить, путь к файлу с иконкой, индекс иконки и всплывающая подсказка для директории (подсказка не обязательна).

Теперь, когда файл desktop.ini создан, необходимо изменить атрибуты папки и добавить системный флаг. Чтобы иконка отображалась правильно, желательно установить системный флажок как для папки, так и для её родителя. Для установки атрибутов воспользуемся функцией SetFileAttribue():


//Устанавливаем системные атрибуты для папки и её родителя   
SetFileAttributes(PChar(edFolderPath.Text), FILE_ATTRIBUTE_SYSTEM);   
if Length(edFolderPath.Text) > 3 then //Если директория не корневая...   
begin   
  //функция LastChar возвращает индекс последнего вхождения символа   
  //в строку. Этот способ позволяет быстро получить путь родительской   
  //директориии, если, конечно, директория не является корневой на диске...   
  tempDir := Copy( edFolderPath.Text, 1,LastChar(edFolderPath.Text, '')-1);   
  SetFileAttributes(PChar(tempDir), FILE_ATTRIBUTE_SYSTEM);                 
end;  

Теперь можно открыть Проводник и посмотреть на значок.

Добавлено: 02 Августа 2018 07:32:40 Добавил: Андрей Ковальчук

Последовательный поиск

Для понимания этой статьи вам будет достаточно базовых знаний о программировании баз данных в Delphi.

Основная форма проекта должна содержать компоненты TTable и TEdit (назовем его edtSearch). Заметим, что таблица, к которой прикреплен компонент TTable, должна быть проиндексирована по полю, в котором производится поиск.

Компонент TTable содержит несколько методов для поиска заданного значения в таблице. Это методы Goto, GoToKey, GoToNearest, Find, FindKey, Find Nearest и другие (описание этих методов смотрите в помощи). Добавим обработчик события OnChange для компонента TEdit:


procedure TForm1.edtSearchChange(Sender: TObject);  
begin  
  with Table1 do begin  
    SetKey;  
    FieldByName('Company').AsString:=edtSearch.text;  
    GotoNearest;  
  end;  
end;  

Собственно, все. Можно откомпилировать и запустить программу. Введите что-нибудь в поле ввода и вы увидите, как после набора каждого символа указатель текущей записи таблицы перемещается, указывая на запись, сответствующую тому, что вы ввели.

Теперь можно немного усложнить обработчик onChange. Например, можно отключить обработчик, если пользователь нажимает Backspace или Delete, или поле ввода не содержит текста. Выглядеть это будет примерно так:


procedure TForm1.edtSearchChange(Sender: TObject);  
var txt, sfind:string;  
      len:integer;  
begin  
  //don't do anything if user presses  
  //delete or backspace  
  if edFromCode = true then begin  
    edFromCode := false;  
    exit;  
  end;  
  
  //don't do anything if there is  
  //no text in edSearch  
  txt:=edtSearch.Text;  
  if Length(txt)=0 then exit;  
  
  //goto nearest match  
  with Table1 do begin  
    SetKey;  
    FieldByName('Company').AsString:=edtSearch.text;  
    GotoNearest;  
  end;  
  
  //calculate what part of text should be selected  
  sfind := Table1.FieldByName('Company').AsString;  
  len := Length(sfind) - Length(txt);  
  if len > 0 then begin  
    edFromCode:=true;  
    edtSearch.Text:=sfind;  
    edtSearch.SelStart:=Length(txt);  
    edtSearch.SelLength:=len;  
  end;  
end;  

Для такого случая нужен дополнительный код - обработчик события onKeyDown:


procedure TForm1.edtSearchKeyDown(Sender: TObject; var Key: Word;  
                Shift: TShiftState);  
begin  
  if (Key=VK_DELETE) or (Key=VK_BACK) then begin  
    if Lenght(edtSearch.Text)>0 then begin  
    //onchange event should not be executed...  
      edFromCode := true;  
    end;  
  end;  
end;   

Добавлено: 02 Августа 2018 07:31:42 Добавил: Андрей Ковальчук

Компонент Edit внутри компонента ListBox

Сегодня мы сделаем так что бы запись в компоненте ListBox можно было бы редактировать просто кликнув на неё. Грубо мы будем динамически создавать компонент Edit внутри компонента ListBox.

Ну что открываем Delphi, создаем новый проект, на форму кидаем компонент ListBox с закладки Standard.

Далее после ключевого слова private пишем


ListEdit : TEdit;  
procedure ListEditKeyPress(Sender: TObject; var Key: Char) ; 

Как вы наверно поняли здесь мы создали компонент Edit с именем ListEdit и обьявили процедуру KeyPress для компонента ListEdit

Нажимаем комбинацию клавиш CTRL+SHIFT+C для того что бы прописать код для процедуры ListEditKeyPress. Полный код процедуры будет выглядеть следующим образом (посмотрите как получилось у меня и допишите недостающие строки)


procedure TForm1.ListEditKeyPress(Sender: TObject; var Key: Char);  
var  
ii: Integer;  
begin  
if Key = #13 then  
begin  
ii := ListBox1.ItemIndex;  
ListBox1.Items.Delete(ii) ;  
ListBox1.Items.Insert(ii, ListEdit.Text) ;  
ListEdit.Visible := False;  
Key := #0;  
end;  
end;  

Теперь выделяем форму и создаем на ней обработчик событий OnCreate (полный код обработчика представлен ниже)


procedure TForm1.FormCreate(Sender: TObject) ;  
begin  
ListEdit := TEdit.Create(self) ;  
ListEdit.Visible := false;  
ListEdit.Ctl3D := false;  
ListEdit.BorderStyle := bsNone;  
ListEdit.Parent := ListBox1;  
ListEdit.Width := ListBox1.ClientWidth;  
ListEdit.OnKeyPress := ListEditKeyPress;  
end;  

Немного поясню что я здесь написал, т.к компонент ListEdit мы создаем динамически то и необходимые свойства нам нужно задавать вручную. Чем мы сейчас и занимаемся.

Далее выделяем компонент ListBox, на нем создадим обработчик событий Onclick


procedure TForm1.ListBox1Click(Sender: TObject) ;  
var  
ii : integer;  
lRect: TRect;  
begin  
ii := ListBox1.ItemIndex;  
if ii = -1 then exit;  
lRect := ListBox1.ItemRect(ii) ;  
ListEdit.Top := lRect.Top + 1;  
ListEdit.Left := lRect.Left + 1;  
ListEdit.Height := (lRect.Bottom - lRect.Top) + 1;  
ListEdit.Text := ListBox1.Items.Strings[ii];  
ListBox1.Selected[ii] := False;  
ListEdit.Visible := True;  
ListEdit.SelectAll;  
ListEdit.SetFocus;  
end;  

НА этом все можите запускаться!!!

Добавлено: 02 Августа 2018 07:30:54 Добавил: Андрей Ковальчук

Сохранить исходник HTML из TWebBrowser

Сегодня мы научимся сохранять исходник HTML из TWebBrowser.Document на диск. Делается это очень просто и я думаю трудностей с этим у вас возникнуть недолжно.

Ну что поехали, как всегда для начала открываем Delphi и первое что нам нужно будет сделать это дописать в раздел uses ActiveX. Двигаемся дальше теперь кидаем на форму две кнопочки (button) с закладки standart, компонент SaveDialog с закладки Dialog и компонент webBrowser с закладки internet. Так с компонентами вроде разобрались

Создаем обработчик событий(onclick) на первой кнопке и в нем прописываем следующий код:


webbrowser1.Navigate('http://www.delphiexpert.ru');  

Так теперь переходим на самый верх и сразу же после public пишем:


procedure SaveHTMLSourceToFile(const FileName: string; WB: TWebBrowser);  

Нажимаем комбинацию клавиш Ctrl+Shift+C

И Delphi автоматически генерирует процедуру, получиться должно примерно так:


procedure TForm1.SaveHTMLSourceToFile(const FileName: string;  
WB: TWebBrowser);  
begin  
  
end;  

Сейчас давайте пропишем действия, которые будет выполнять данная процедура, а именно она должна сохранять текущий открытый в компоненте webbrowser документ в виде исходника HTML


procedure TForm1.SaveHTMLSourceToFile(const FileName: string;  
WB: TWebBrowser);  
var  
PersistStream: IPersistStreamInit;  
FileStream: TFileStream;  
Stream: IStream;  
SaveResult: HRESULT;  
begin  
PersistStream := WB.Document as IPersistStreamInit;  
FileStream := TFileStream.Create(FileName, fmCreate);  
try  
Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;  
SaveResult := PersistStream.Save(Stream, True);  
if FAILED(SaveResult) then  
MessageBox(Handle, 'Fail to save HTML source', 'Error', 0);  
finally  
FileStream.Free;  
end;  
end;  

Вот практически и все осталось только создать обработчик событий (onClick) на второй кнопке и прописать там:


if SaveDialog1.Execute then  
SaveHTMLSourceToFile(SaveDialog1.FileName, WebBrowser1);   

Запускаем программу, жмем сначала на первую кнопку, ждем пока в компоненте WebBrowser загрузиться страница.

Теперь нажимаем на вторую кнопку и сохраняем загруженную страницу, в Поле Имя файла: вводим например delphi.txt или expert.html

Добавлено: 01 Августа 2018 08:43:50 Добавил: Андрей Ковальчук

Создание окна мастера

Сегодня я раскажу тебе, как можно создать простейшее и удобное окно мастера. В нём будет создано несколько панелей, каждая из которых будет содержать инфу для определённого шага и при выполнении панели будут просто сменять друг-друга.

Создай новый проект. Брось на форму две кнопки "Назад" и "Далее". Теперь положи на форму компонент TPanel c закладки "Standard"

Установи на нём любые компоненты, а можешь просто сделать какую-нибудь надпись. Теперь брось на форму ещё одну панель. Её нужно поставить прямо над первой панелью. Если ты скачаешь пример в конце этой статьи и посмотришь его, то увидишь, что под панелями прячутся ещё панели, хотя на первый взгял их не видно.

Теперь создадим обработчик события OnShow для формы и напишем в нём следующее:


procedure TForm1.FormShow(Sender: TObject);  
begin  
 Panel1.Visible:=true;  
 Panel2.Visible:=false;  
 Panel3.Visible:=false;  
end;  

Здесь я делаю все панели невидимыми кроме первой. Теперь нам надо сделать так, чтобы по нажатии кнопки "Дальше" появлялась вторая панель, а затем третья. Для этого в обработчике события OnClick для кнопки "Далее" напишем:


procedure TForm1.Button1Click(Sender: TObject);  
begin  
 //Если видна первая панель, то сделать видимой вторую  
 if Panel1.Visible=true then  
  begin  
   Panel1.Visible:=false;  
   Panel2.Visible:=true;  
   exit;  
  end;  
  
 //Если видна вторая панель, то сделать видимой первую  
 if Panel2.Visible=true then  
  begin  
   Panel2.Visible:=false;  
   Panel3.Visible:=true;  
   exit;  
  end;  
end;  

Теперь, то же самое, только для кнопки "Назад", чтобы мы могли двигатся в обратном порядке - от третей панели к первой. Для этого нужно обработать событие OnClick для кнопки "Назад":


procedure TForm1.Button2Click(Sender: TObject);  
begin  
 if Panel3.Visible=true then  
  begin  
   Panel3.Visible:=false;  
   Panel2.Visible:=true;  
   exit;  
  end;  
  
 if Panel2.Visible=true then  
  begin  
   Panel2.Visible:=false;  
   Panel1.Visible:=true;  
   exit;  
  end;  
end;  

Вот и всё. Хотя я расскзал, как можно сделать мастер, такую подмену можно использовать везде. Главное понять смысл, а он прост, как секс :).

Добавлено: 01 Августа 2018 08:43:02 Добавил: Андрей Ковальчук

Скриншот страницы в компоненте WebBrpwser

Сегодня мы, будем делать скриншот активной web страницы в компоненте webbrowser.
Итак нам понадобятся следующие компоненты: WebBrowser с закладки Internet, 2 компонента Button с зкладки Standard.
Для начала после ключевого слова uses допишите ActiveX, jpeg

Далее нам нужно создать небольшую процедурку которая и будет делать скриншоты, поэтому после ключевого слова public пишем:


procedure WebBrowserScreenShot(const wb: TWebBrowser; const fileName: TFileName) ;  

Нажимаем комбинацию клавиш CTRL+SHIFT+C, Delphi создаст шаблон процедуры, а вот что должно получиться в итоге:


procedure TForm1.WebBrowserScreenShot(const wb: TWebBrowser;  
const fileName: TFileName);  
var  
viewObject : IViewObject;  
r : TRect;  
bitmap : TBitmap;  
begin  
if wb.Document <> nil then  
begin  
wb.Document.QueryInterface(IViewObject, viewObject) ;  
if Assigned(viewObject) then  
try  
bitmap := TBitmap.Create;  
try  
r := Rect(0, 0, wb.Width, wb.Height) ;  
bitmap.Height := wb.Height;  
bitmap.Width := wb.Width;  
viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Application.Handle, bitmap.Canvas.Handle, @r, nil, nil, 0) ;  
with TJPEGImage.Create do  
try  
Assign(bitmap) ;  
SaveToFile(fileName) ;  
finally  
Free;  
end;  
finally  
bitmap.Free;  
end;  
finally  
viewObject._Release;  
end;  
end;  
end;   

*Посмотрите на этот код и на свой шаблон, допишите не достающие строки !
Двигаемся дальше, создаем обработчик событий OnClick на первой кнопке, в нем прописываем вот такую строку:


WebBrowser1.Navigate('http://delphiexpert.ru') ;   

Теперь создаем обработчик событий на второй кнопке, между begin ... end пропишите:


WebBrowserScreenShot(WebBrowser1,'c:\WebBrowserImage.jpg') ;   

Вот в принципе и все, запускаем проект, нажимаем сначала на первую кнопку - в WebBrouser'e открывается страница www.delphiexpert.ru. Теперь жмем на вторую кнопку и на диске C:\ создается файл с именем WebBroserImage.jpg в котором будет находиться скриншот сайта delphiexpert.ru

На этом всё.

Добавлено: 01 Августа 2018 08:42:10 Добавил: Андрей Ковальчук

Создаем Анимированный ProgressBar

Всем привет в этом уроке мы научимся создавать свой анимированный ProgressBar, подойдет он для тех случаев когда точное число шагов неизвестно, ну в общем скоро вы все поймете ) Итак поехали:

Открываем Delphi и как всегда создаем новый проект, кидаем на форму компонент Timer с закладки System и компонент Image с закладки Additional, больше компонентов у нас не будет! Двигаемся дальше, сейчас нам нужно будет создать одну небольшую процедурку поэтому переходим в код находим там ключевое слово public и после него пишем


procedure GoImgProgress (Const IMG: TImage);  

Нажимаем комбинацию клавиш Ctrl+Shift+C Delphi генерирует нам шаблон будущей процедуры. Теперь посмотрите то что должно получиться в конце и допишите к своему шаблону недостающие строчки.


procedure TForm1.GoImgProgress(const IMG: TImage);  
const  
step=2;  
var  
f:Tbitmap;  
begin  
with image1.Picture.Bitmap do // Image1 - это имя компонента image  
begin  
f:= Tbitmap.create;  
try  
f.width:=width;  
f.height:=height;  
BitBlt(f.Canvas.Handle, step, 0, Width-step, Height, Canvas.Handle, 0, 0, SRCCOPY) ;  
BitBlt(f.Canvas.Handle, 0, 0, step, Height, Canvas.Handle, Width-step, 0, SRCCOPY) ; ;  
Assign(f) ;  
finally  
FreeAndNil(f) ;  
end;  
end;  
end;  

Ну что я надеюсь что вы справились, потому что сейчас нам нужно будет загрузить в компонент image1 какую ни будь картинку в формате bmp. Кликаем два раза на компонент image, далее жмем load и выбираем нужную картинку. Лично я пользовался вот этой:

Далее переходим к компоненту timer, свойство interval ставим 100, свойство Enabled ставим true. Создаем обработчик событий (OnTimer) на нашем таймере - два раза кликаем по нему и между словами begin end пишем:


GoImgProgress(image1);  

Вот и всё, теперь вы умеете создавать анимированный Progressbar ! Запускаем проект и наслаждаемся !)

Добавлено: 01 Августа 2018 08:41:22 Добавил: Андрей Ковальчук

Основные функции библиотеки BASS 2.4

Иницилаизирует звуковой поток


function BASS_Init(device: Integer; freq, flags: DWORD; win: HWND; clsid: PGUID): BOOL;  
// Пример использования:  
BASS_Init(-1, 44100, 0, handle, nil);  

Очищает звуковой поток, в скобках указываем имя потока.


function BASS_StreamFree(handle: HSTREAM): BOOL;  

Создаем звуковой поток из локального файла


function BASS_StreamCreateFile(mem: BOOL; f: Pointer; offset, length: QWORD; flags: DWORD): HSTREAM;   
// Пример использования  

Имя потока := Bass_streamCreateFile(false, PChar('C:\muzic.mp3'),0,0,0);
Узнать длинну звукового потока


function BASS_ChannelGetLength(handle, mode: DWORD): QWORD;  
// Пример использования  
BASS_ChannelGetLength(Имя потока,0);  

Начать проигрывать звук


function BASS_ChannelPlay(handle: DWORD; restart: BOOL): BOOL;  
// Пример использования:  
Bass_channelPlay(Имя потока, false);   

Сделать паузу


function BASS_ChannelPause(handle: DWORD): BOOL;  
// Пример использования  
BASS_ChannelPause(Имя потока);   

Остановить проигрывание звука.


function BASS_ChannelStop(handle: DWORD): BOOL;  
// Пример использования  
BASS_ChannelStop(Имя потока); 

Установить новую позицию в потоке( необходимио для перемотки) Сдвигает позицию проигрывания на pos вперед.


function BASS_ChannelSetPosition(handle: DWORD; pos: QWORD; mode: DWORD): BOOL;  
// Пример использования  
BASS_ChannelSetPosition(Имя потока, ScrollBar1.Position, 0);   

Получает атрибуты канала. Если не хочешь получать какое-нибудь свойство, ставь null


function BASS_ChannelGetAttribute(handle, attrib: DWORD; var value: FLOAT): BOOL;  

Добавлено: 01 Августа 2018 08:40:43 Добавил: Андрей Ковальчук