Отображение округленного окошка подсказок для значка приложения в System Tray

В Windows 2000 и выше, формат структуры NotifyIconData, которая используется для работы с иконками в Трее (которая, кстати, называется "The Taskbar Notification Area") значительно отличается от предыдущий версий Windows. Однако, эти изменения НЕ отражены в юните ShellAPI.pas в Delphi 5.

Итак, нам понадобится преобразованный SHELLAPI.H, в котором присутствуют все необходимые объявления:


uses Windows;  
   
type  
  NotifyIconData_50 = packed record // определённая в shellapi.h  
  cbSize: DWORD;  
  Wnd: HWND;  
  uID: UINT;  
  uFlags: UINT;  
  uCallbackMessage: UINT;  
  hIcon: HICON;  
  szTip: array[0..MAXCHAR] of AnsiChar;  
  dwState: DWORD;  
  dwStateMask: DWORD;  
  szInfo: array[0..MAXBYTE] of AnsiChar;  
  uTimeout: UINT; // union with uVersion: UINT;  
  szInfoTitle: array[0..63] of AnsiChar;  
  dwInfoFlags: DWORD;  
end{record};  
   
const  
  NIF_INFO = $00000010;  
   
  NIIF_NONE = $00000000;  
  NIIF_INFO = $00000001;  
  NIIF_WARNING = $00000002;  
  NIIF_ERROR = $00000003;  

А это набор вспомогательных типов:

type  
  TBalloonTimeout = 10..30{seconds};  
  TBalloonIconType = (bitNone, // нет иконки  
  bitInfo, // информационная иконка (синяя)  
  bitWarning, // иконка восклицания (жёлтая)  
  bitError); // иконка ошибки (красная)  

Теперь мы готовы приступить к созданию округлённых подсказок! Для этого воспользуемся следующей функцией:

uses SysUtils, Windows, ShellAPI;  
   
function BalloonTrayIcon(const Window: HWND; const IconID: Byte;   
  
const Timeout: TBalloonTimeout; const BalloonText,  
BalloonTitle: String; const BalloonIconType: TBalloonIconType): Boolean;  
const  
  aBalloonIconTypes : array[TBalloonIconType] of Byte = (NIIF_NONE, NIIF_INFO, NIIF_WARNING, NIIF_ERROR);  
var  
  NID_50 : NotifyIconData_50;  
begin  
  FillChar(NID_50, SizeOf(NotifyIconData_50), 0);  
  with NID_50 do  
  begin  
    cbSize := SizeOf(NotifyIconData_50);  
    Wnd := Window;  
    uID := IconID;  
    uFlags := NIF_INFO;  
    StrPCopy(szInfo, BalloonText);  
    uTimeout := Timeout * 1000;  
    StrPCopy(szInfoTitle, BalloonTitle);  
    dwInfoFlags := aBalloonIconTypes[BalloonIconType];  
  end{with};  
  Result := Shell_NotifyIcon(NIM_MODIFY, @NID_50);  
end;  

Вызывается она следующим образом:

BalloonTrayIcon(Form1.Handle, 1, 10, 'this is the balloon text', 'title', bitWarning);  

Иконка, должна быть предварительно добавлена с тем же дескриптором окна и IconID (в данном примере Form1.Handle и 1).

Можете попробовать все три типа иконок внутри всплывающей подсказки.

Несколько заключительных замечаний:

Нет необходимости использовать большую структуру NotifyIconData_50 для добавления или удаления иконок, старая добрая структура NotifyIconData прекрасно подойдёт для этого.
Для callback сообщения можно использовать WM_APP + что-нибудь.
Используя различные IconID, легко можно добавить несколько различных иконок из одного родительского окна и работать с ними по их IconID.

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

Клонирование объектов

Создать копию объекта в Delphi очень просто. Конвертируем объект в текст, а затем - обратно. При этом будут продублированы все свойства, кроме ссылок на обработчики событий. Для преобразования компонента в файл и обратно нам понадобятся функции потоков WriteComponent(TComponent) и ReadComponent(TComponent). При этом в поток записывается двоичный ресурс. Последний с помощью функции ObjectBinaryToText можно преобразовать в текст.
Создадим на их основе функции преобразования:


function ComponentToString(Component: TComponent): string;   
var   
  ms: TMemoryStream;   
  ss: TStringStream;   
begin   
  ss := TStringStream.Create(' ');   
  ms := TMemoryStream.Create;   
  try   
    ms.WriteComponent(Component);   
    ms.position := 0;   
    ObjectBinaryToText(ms, ss);   
    ss.position := 0;   
    Result := ss.DataString;   
  finally   
    ms.Free;   
    ss.free;   
  end;   
end;   
   
procedure StringToComponent(Component: TComponent; Value: string);   
var   
  StrStream:TStringStream;   
  ms: TMemoryStream;   
begin   
  StrStream := TStringStream.Create(Value);   
  try   
    ms := TMemoryStream.Create;   
    try   
      ObjectTextToBinary(StrStream, ms);   
      ms.position := 0;   
      ms.ReadComponent(Component);   
    finally   
      ms.Free;   
    end;   
  finally   
    StrStream.Free;   
  end;   
end;  

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


object Form1: TForm1   
  Left = 262   
  Top = 129   
  Width = 525   
  Height = 153   
  Caption = 'Form1'   
  Color = clBtnFace   
  Font.Charset = DEFAULT_CHARSET   
  Font.Color = clWindowText   
  Font.Height = -11   
  Font.Name = 'MS Sans Serif'   
  Font.Style = []   
  OldCreateOrder = False   
  Scaled = False   
  PixelsPerInch = 96   
  TextHeight = 13   
  object Button1: TButton   
    Left = 16   
    Top = 32   
    Width = 57   
    Height = 49   
    Caption = 'Caption'   
    TabOrder = 0   
    OnClick = Button1Click   
  end   
end   
   
procedure TForm1.Button1Click(Sender: TObject);   
var   
  Button: TButton;   
  OldName: string;   
begin   
  Button := TButton.Create(self);   
   
  //...сохраняем имя компонента   
  OldName := (Sender as TButton).Name;   
   
  //...стираем имя компонента, чтобы избежать конфликта имен.  
  //...После этого Button1 станет = nil.   
  (Sender as TButton).Name := '';   
   
  //...преобразуем в текст и обратно   
  StringToComponent( Button, ComponentToString(Sender as TButton) );   
   
  //...дадим компоненту уникальное(?) имя   
  Button.Name := 'Button' + IntToStr(random(1000));   
   
  //...вернем исходному компоненту имя.  
  //...После этого Button1 станет снова указывать на объект.   
  (Sender as TButton).Name := OldName;   
   
  //...размещаем новую кнопку справа от исходной   
  Button.parent := self;   
  Button1.Tag := Button1.Tag + 1;   
  Button.Left := Button.Left + Button.Width * Button1.Tag + 1;   
end;  

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

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

Работа с HTML-справкой в программах

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

В раздел глобальных переменных добавьте следующие переменные для работы со справкой:


_HHwinHwnd: HWND = 0; HHCtrlHandle: THandle = 0; mHelpFile: String;  

Сразу после раздела глобальных переменных и перед implementation вставьте следующие строки кода:


var  
  HtmlHelpA: function(hwndCaller: HWND; pszFile: PAnsiChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
  HtmlHelpW: function(hwndCaller: HWND; pszFile: PWideChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
  HtmlHelp: function(hwndCaller: HWND; pszFile: PChar; uCommand: UInt; dwData: DWORD): HWND; stdcall;  
   
const  
  hhctrlLib = 'hhctrl.ocx';  
  HH_DISPLAY_TOPIC = $0000;  
  HH_HELP_CONTEXT = $000F;  
  HH_CLOSE_ALL = $0012;  

Где-нибудь в самом начале раздела implementation вставьте код:


const hhPathRegKey = 'CLSID\{adb880a6-d8ff-11cf-9377-00aa003b7a11}\InprocServer32';  
   
function GetPathToHHCtrlOCX: string;  
var Reg: TRegistry;  
begin  
  result := ''; //default return  
  Reg := TRegistry.Create;  
  Reg.RootKey := HKEY_CLASSES_ROOT;  
  if reg.OpenKeyReadOnly(hhPathRegKey) then  
    begin  
    result := Reg.ReadString(''); Reg.CloseKey;  
    if (result <> '') and (not FileExists(result)) then result := '';  
  end;  
  Reg.Free;  
end;  
   
procedure LoadHtmlHelp;  
var OcxPath: string;  
begin  
  if HHCtrlHandle = 0 then  
  begin  
    OcxPath := GetPathToHHCtrlOCX;  
    if (OcxPath <> '') and FileExists(OcxPath) then  
    begin  
      HHCtrlHandle := LoadLibrary(PChar(OcxPath));  
      if HHCtrlHandle <> 0 then  
      begin  
        @HtmlHelpA := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');  
        @HtmlHelpW := GetProcAddress(HHCtrlHandle, 'HtmlHelpW');  
        @HtmlHelp := GetProcAddress(HHCtrlHandle, 'HtmlHelpA');  
      end;  
    end;  
  end;  
end;  
   
procedure UnloadHtmlHelp;  
begin  
  if HHCtrlHandle <> 0 then  
  begin  
    FreeLibrary(HHCtrlHandle);  
    HHCtrlHandle := 0;  
  end;  
end;  

В OnCreate главной формы приложения добавьте:


mHelpFile := ExtractFilePath(ParamStr(0)) + 'Help.chm';  
mHelpFile := ExpandFileName(mHelpFile);  
LoadHtmlHelp;  
if HHCtrlHandle = 0 then  
  ShowMessage('HTML-справка не поддерживается системой');  

В обработчике пункта меню для загрузки справки (например, Справка - Содержание) пишем:


if HHCtrlHandle = 0 then  
  showmessage('Справка не поддерживается')  
else  
  HtmlHelp(Handle,PChar(mHelpFile+'::/Pages/topic1.htm'),HH_DISPLAY_TOPIC,0);  

При выходе из программы необходимо закрыть все открытые окна справки, поэтому в OnClose главной формы добавляйте строку:


HtmlHelp(0, nil, HH_CLOSE_ALL, 0);  

Часто в программах делают другие пункты меню, соответствующие разделам справки. Вот как их загружать:


HtmlHelp(Handle,PChar(mHelpFile+'::/путь/страница.htm'),HH_DISPLAY_TOPIC,0);  

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

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

Секреты 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 Добавил: Андрей Ковальчук