Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

27th
Фев

Задать HotKey в ListView на Delphi

Posted by obzor under Delphi

Нужно сделать ListView со стилем LVS_REPORT, чтобы каждый элемент второго или третьего столбца содержал в себе HotKey. При изменении клавиш в хоткее, получать индекс ListView и записывать измененную клавишу в переменную.
куда копать?
Или так (второй вариант): делаем даблклик по строке ListView. Создаем HotKey во втором столбце ListView. Когда HotKey потеряет фокус, уничтожаем его и записываем клавишу в текстовом виде в нужную позицию ListView.
Будет ли это работать? Какой вариант проще сделать?

kutani

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

Подобное делал на базе стринггрида и пары API-процедур:
Название: Безымянный.PNG Просмотров: 14 Размер: 9.4 Кб
но можно приспособить и листфивер.

Даю пример над 4-й колонкой грида. Объявим перехватчик и процедуру преобразования и регистрации динамического набора горячих клавиш:

Код:


protected
    procedure ghotkey(var msg:TMessage); message WM_HOTKEY;
  public
    procedure gl_hook(key1,key2: integer; p: boolean);
  end;


//--- HOTKEY
function strtohotkey(key:string; p: boolean):integer;
begin
 result:= 0;
 if (key = 'Нет')or(key = '') then exit;
 
 if p then begin
  if pos('Alt',key)>0   then result:= 1;
  if pos('Ctrl',key)>0  then result:= 2;
  if pos('Shift',key)>0 then result:= 4
 end else result:= ord(key[length(key)])
end;

function hotkeytostr(Key: Word; shift: TShiftState): string;
begin
 result:= '';
 if (ssctrl in shift)  then result:= 'Ctrl';
 if (ssalt in shift)   then result:= 'Alt';
 if (ssshift in shift) then result:= 'Shift';

 if (key<>16)and(key<>17)and(key<>18) then
 if result = '' then result:= chr(key)
  else result:= result + ' + ' + chr(key);

 if (key = vk_delete)or(result='Ctrl')or(result='Alt')or(result='Shift') then
  result:= 'Нет'
end;

procedure Tdllg1.gl_hook(key1,key2: integer; p: boolean);
var i: integer;
begin
 if p then begin //горячие клавиши-
  setlength(id,length(id)+1);
  id[length(id)-1]:= GlobalAddAtom(pchar('hotkey' + inttostr(length(id)-1)));
  RegisterHotKey(handle,id[length(id)-1],key1,key2);

 end else begin //анрег- горячих клавиш
  for i:=0 to length(id)-1 do UnRegisterHotKey(handle,id);
  setlength(id,1);
 end
end;

procedure Tdllg1.ghotkey(var msg:TMessage);
var i,j,k: integer;
begin
 if not Visible then

 for i:= 1 to sg1.RowCount-1 do
  if (sg1.Cells[4,i]<>'Нет')and(sg1.Cells[4,i]<>'') then begin
   if (msg.LParamLo = strtohotkey(sg1.Cells[4,i],true))and
      (msg.LParamHi = strtohotkey(sg1.Cells[4,i],false)) then begin
       //поиск команды-
       k:=0;
       for j:=0 to cmd.Items.Count-1 do
        if cmd.Items[j]= sg1.Cells[0,i] then begin k:=j;break;end;
       //проверка на выполнение-
       if fileexists(sg1.Cells[0,i]) then
           begin path_pr:= sg1.Cells[0,i]; k:= 58 end;
       if sg1.Cells[0,i][1]='>'      then
           begin path_pr:= copy(sg1.Cells[0,i],3,length(sg1.Cells[0,i])); k:= 59 end;
       if k<>0 then vid.icc(k)
   end

  end
end;

Тут отследим колонку ввода новых горячих:

Код:


procedure Tdllg1.sl1SelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
var R: TRect;
begin
 selc:= ARow;
 selq:= ACol;
...
end;


procedure Tdllg1.sg1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i: integer;
begin
 if selq = 4 then begin
  sg1.Cells[4,selc]:= hotkeytostr(Key,shift);

  gl_hook(0,0,false);
  for i:= 1 to sg1.RowCount-1 do
   if (sg1.Cells[4,i]<>'Нет')and(sg1.Cells[4,i]<>'') then
    gl_hook(strtohotkey(sg1.Cells[4,i],true),
            strtohotkey(sg1.Cells[4,i],false),
            true)
 end
end;

Заполнение командами и регистрация горячих клавиш по списку:

Код:


procedure Tdllg1.FormCreate(Sender: TObject);
var i,j: integer;
begin
 ...
  //загрузка планировщика-
  for i:=1 to ini.ReadInteger('sh','count',0) do begin //строки
   for j:=0 to sg1.ColCount-1 do   //столбцы
    sg1.Cells[j,i]:= sel_getname(ini.ReadString('sh',inttostr(i),''),j+1);
   sg1.RowCount   := sg1.RowCount+1;
  end;

  //загрузка HOTKEY-
  gl_hook(0,0,false);
  for i:= 1 to sg1.RowCount-1 do
   if (sg1.Cells[4,i]<>'Нет')and(sg1.Cells[4,i]<>'') then
    gl_hook(strtohotkey(sg1.Cells[4,i],true),
            strtohotkey(sg1.Cells[4,i],false),
            true)
 
 end;
...