Это всё сводится к обработке сообщения WM_DRAWCLIPBOARD, но дело в том, что никто просто так нам его не отправит. 

Немного теории.

Есть такое понятие, как «Clipboard chain» - назовём это цепочкой буфера обмена. Фактически в ней содержится список handle’ов окон, которым посылается сообщение WM_DRAWCLIPBOARD. На самом деле оно посылается только первому окну в цепочке. И каждое окно в этой цепочке должно (обязано :) ) обрабатывать это сообщение и ещё одно, о котором речь пойдёт дальше.

Поехали!

Итак, как же нам попасть в эту цепочку? Для этого есть функция SetClipboardViewer.
Создадим новый проект, на событие создания формы (или в любой другой нужный нам момент) напишем:

nhwnd:=SetClipboardViewer(Handle);

nhwnd – глобальная переменная типа Cardinal (тот же THandle), в неё мы получили следующий в цепочке handle, она нам пригодится в других процедурах.

Теперь нужно позаботиться о том, чтобы удалять себя из цепочки в том случае, когда нам уже не нужно перехватывать обновление информации в буфере – например, при закрытии.

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, nwnd);
end;

Функция  ChangeClipboardChain удаляет нас из цепочки. Функция рассылает сообщение WM_CHANGECBCHAIN окнам цепочки, нам это сообщение также предстоит обработать. Обычно возвращает false, true только в случае, если наше окно в цепочке было единственным. Нам результат этой функции не очень-то и важен.

Обработаем WM_CHANGECBCHAIN. Для тех, кто подзабыл: в раздел private типа TForm1 пишем procedure WMChangeCBChain(var msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; и обрабатываем:

procedure TForm1.WMChangeCBChain(var msg: TWMChangeCBChain);
begin
 if msg.Remove=nwnd then
   nwnd:=msg.Next
 else
   SendMessage(nwnd, WM_CHANGECBCHAIN, msg.Remove, msg.Next);
end;

Здесь всё тоже несложно: если удалилось следующее в цепочке окно, берём на заметку – меняем nwnd на теперь действительное следующее окно. Иначе уведомляем следующее окно, как этого требует цепочка.

Осталось только обработать событие  WM_DRAWCLIPBOARD:

procedure TForm1.WMDrawClipBoard(var msg: TWMDrawClipboard);
begin
 if ClipBoard.HasFormat(CF_TEXT) then
   ShowMessage(ClipBoard.AsText)
 else
   ShowMessage('скопирован не текст');
 SendMessage(nwnd, WM_DRAWCLIPBOARD, 0, 0);
end;

Вот так вот, всё просто. Смотрим, что скопировано, делаем, что нам нужно, и отправляем сообщение по цепочке дальше.

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

Для ленивых предлагаю скачать исходник.

(c) crystalbit, http://parsers.info
При копировании материала обязательно ставить прямую ссылку на источник.

Похожие записи

• Работаем с окнами. AnimateWindow и FlashWindow. (0)
• Работаем с окнами и объектами. Часть 4. Функции и процедуры. (0)
• Работаем с окнами и объектами. Часть 3. Поиск объектов. (0)
• Работаем с окнами и объектами. Часть 2 (0)
• Работаем с окнами и объектами. Delphi. Api. Часть 1 (0)

Чтобы поменять его размеры, нужно познакомиться с ним поближе.

Что нам о нём известно?

Его размеры можно получить с помощью api функции GetConsoleScreenBufferInfo, вот её синтаксис:

function GetConsoleScreenBufferInfo(hConsoleOutput: THandle; var lpConsoleScreenBufferInfo: TConsoleScreenBufferInfo): BOOL;

По порядку:
hConsoleOutput: THandle – handle вывода консольного окна, его нам вернёт api функция GetStdHandle с параметром STD_OUTPUT_HANDLE;
lpConsoleScreenBufferInfo: TConsoleScreenBufferInfo – сюда передаём объект типа TConsoleScreenBufferInfo

Структура CONSOLE_SCREEN_BUFFER_INFO, она же TConsoleScreenBufferInfo, она же _CONSOLE_SCREEN_BUFFER_INFO:

  _CONSOLE_SCREEN_BUFFER_INFO = packed record
    dwSize: TCoord;
    dwCursorPosition: TCoord;
    wAttributes: Word;
    srWindow: TSmallRect;
    dwMaximumWindowSize: TCoord;
  end;

Функция GetConsoleScreenBufferInfo её нам заполнила, что мы получили:
dwSize: TCoord – размер буфера, вот он! (по умолчанию 80 на 300 символов)
dwCursorPosition: TCoord – положение курсора, тоже полезно, вполне заменит паскалевские WhereX и WhereY, они также реализованы в моём модуле crt
wAttributes: Word – не экспериментировал с этим, вроде цвета
srWindow: TSmallRect – тоже не экспериментировал, по msdn это координаты окна, уточни какого и напиши в комментарии, ок?
dwMaximumWindowSize: TCoord – максимальный размер буфера, в символах, естественно.

Меняем размер Screen Buffer

Ну и кульминация, функция SetConsoleScreenBufferSize:

SetConsoleScreenBufferSize(hConsoleOutput: THandle; dwSize: TCoord): BOOL;

Передаём тот же handle вывода, и структуру TCoord с нужным нам размером.

Как же без примера?

const
  NewSize: TCoord = (x: 80; y: 10000);

...
  SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), NewSize);

Здесь размер буфера окна стал 80 на 10000.

Постовой:
А тем временем Zdez Bil Ya в своём добром-добром блоге пишет про delphi и пароли в qip.

Похожие записи

• Контролируем буфер обмена (51)

Привет, ты наверняка уже наслышан о недавно появившемся вирусе Piggy. Если не в курсе, буду краток: он использует принцип спама по цепочке.
Вот тебе приходит ссылка от человека, мол, flash игра прикольная. Ты пишешь, мол, ага, знаем, спам. И тебе в ответ: нет, мол, не спам, ага. Качаешь, так как немного пьян, и с твоим номером происходит то же самое: пароль меняется, а эта программа висит некоторое время как icq-бот и предлагает твоим друзьям, которые в контакт-листе, скачать себя. Реагирует на слова «бот», «спам» и прочие по-разному, отвечает, даже меняет статус на «печатает…». Некоторые индивиды окрестили этот вирус как вирус с «искуственным интеллектом», так как сейчас такое – большая редкость.
Думаю, со временем такие боты-болтуны захватят этот мир.

Ну что, если такое случилось, то есть возможность вернуть пароль. Автор программы, видимо, ставил эксперимент :) На хабре появилось сообщение о том, как вернуть пароль: piggy меняет также информацию о пользователе, там теперь можно найти 80 цифр в двоичной системе – 0 или 1.
Например, 01011001100101101010010110100001001100000101101000010110110001011011000101101000 это 57606886. Можно не пытаться переводить в десятичную систему, там просто шифр.
Вот статья – link

А вот шифр, который уже разлетелся по интернетам:

0100110010: 1
0101100000: 2
0101100010: 3
0101100100: 4
0101100110: 5
0101101000: 6
0101101010: 7
0101101100: 8
0101101110: 9
0100110000: 0

Символы идут подряд, без пробелов.

Итак, суть сегодняшнего поста.

Функция copy
Призвана получить часть строки из целой. Синтаксис:

function Copy(S; Index, Count: Integer): string;

S – строка или массив, а в нашем случае строка. Index – с какого символа брать кусок (первый символ это первый символ, а не нулевой), Count это, очевидно, количество.
Это конец теории, далее только код и ссылки на скачку.

Введём массив значений

const
  csymbs:array[0..9] of string=('0100110000', '0100110010',
                                '0101100000', '0101100010',
                                '0101100100', '0101100110',
                                '0101101000', '0101101010',
                                '0101101100', '0101101110' );

Начиная с нуля. Таким приёмом пользуются, чтобы, например, брать имена месяцев из массива.

Теперь получим по шифру его значение. Сначала для одного символа.

function checksymbol(c: string): string;
var
  i:integer;
begin
  result:='n'; // на случай чего-то не того
  for i:=0 to 9 do
    if csymbs[i]=c then Result:=IntToStr(i);
end;

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

А теперь общую функцию
Простой цикл, плюс функция copy.

function decode(c: string):string;
var
  i:integer;
begin
  for i:=0 to 7 do
    result:=result+checksymbol(copy(c, i*10+1, 10));
end;

Само приложение я сделал консольным, использовал модули windows, sysutils и clipbrd. Хоть и консольное, но получилось 368Кб.
Как оно работает: копируем в буфер обмена шифр, запускаем программу и получаем результат.

Скачать парсер пароля :)
Скачать исходник

(c) crystalbit, http://parsers.info

Теперь немного ссылок:

• статья по теме на блоге программиста – link
  В этой статье я нашел картинку:
  
  По ней можно видеть действие вируса.

• и, в качестве постового, я хочу, чтобы ты обратил внимание на блог зелёного кактуса, где он выкладывает вкусности интернета.

Похожие записи

• zparser (0)
• Vkontakte Friends Gop-Stoper by faza02 (2)
• reparser (4)
• q/a bot (5)
• IPDCapture v2FINAL (1)

Сегодня хочу начать цикл заметок о winsock. Около года назад я этим заинтересовался, потом незаслуженно забыл и забросил.
WinSock – достаточно мощный инструмент, основа всех основ. Если ты пишешь программу на чистом api, тебе важен конечный размер программы или работаешь с хитрым протоколом, то сокеты просто незаменимы. В этой заметке рассмотрим, как открыть сокет и послать GET запрос серверу.

Типы сокетов

Вкратце. Есть сокеты синхронные, с ними работать удобнее. Программа (поток) будет ждать, пока запрос посылается, или же ждать ответа. Такие сокеты также называются блокирующими, и речь сегодня пойдёт о них.
Второй тип – асинхронные или неблокирующие сокеты. Из названия вполне очевидно, что, посылая запрос, мы не будем ничего ждать. Нам достаточно будет или иногда проверять состояние, или назначить событие, в разных версиях winsock существует две возможные тактики. Также массив асинхронных сокетов вполне заменяет многопоточность.

Инициализируем winsock

Сперва подключим модуль winsock. Теперь нам необходимо инициализировать winsock, для этого нам потребуется функция WSAStartup. Я использую её следующим образом:

  if WSAStartup(MAKEWORD(2,2), WSAData1)<>0 then begin
    writeln('WinSock error');
    readln;
    Exit;
  end;

MAKEWORD(2,2) – просто константа, точнее возвращает константу, можешь писать $101. WSAData1 – структура типа TWSAData. Не забудь объявить такую :) Как ты уже заметил, в случае успешной инициализации функция возвращает 0, иначе ошибка. Структура TWSAData (WSAData) и коды ошибок есть в msdn, не будем углубляться в голую теорию.
Еще замечу, что я пишу консольное приложение, пусть writeln и readln не смущают читателя.

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

Сокет – как красиво звучит. А это всего лишь число, эх. Socket1:TSocket, Socket1:integer – так надо объявить (TSocket сам по себе integer). Создаём функцией Socket:

  Socket1:=Socket(AF_INET,SOCK_STREAM,0);
  if Socket1=INVALID_SOCKET then begin
    writeln('socket error');
    readln;
    Exit;
  end;

Всё достаточно ясно, примем как есть, нудной теорией займёмся как-нибудь потом.

Устанавливаем соединение.

Сокет – это тебе не Indy или Synapse, здесь запрос делается только после установления соединения (мы сейчас про TCP, UDP не будем затрагивать). Как же нам установить соединение? Объявим следующую переменную: SockAddr1:TSockAddr;. Это структура, в ней укажем протокол, адрес сервера и порт:

  SockAddr1.sin_family:=AF_INET;
  SockAddr1.sin_addr.S_addr:=inet_addr(PChar('62.109.19.221'));
  SockAddr1.sin_port:=htons(80);

Таким образом мы можем указать только ip-адрес. Получению dns будет посвящён отдельный пост. IP-адрес я указал своего блога :)
Теперь функция connect:

  if Connect(Socket1,SockAddr1,SizeOf(SockAddr1))<>0 then begin
    writeln('connection error #',WSAGetLastError);
    readln;
    exit;
  end;

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

Send – посылаем запрос

Объявим две переменных:

  Buffer1:string;
  Buffer2:array[1..1024] of char;

В одной будем формировать запрос, в другую будем порциями писать ответ сервера.

Сначала, конечно, надо сформировать запрос. Если ты хотя бы поверхностно знаком с http протоколом, то это не составит труда:

  Buffer1:='GET / HTTP/1.1'#13#10+
           'host: parsers.info'#13#10+
           'Connection: close'#13#10+
           #13#10;

А теперь можно и послать этот запрос:

  if send(Socket1,Buffer1[1],Length(Buffer1),0)=SOCKET_ERROR then begin
    writeln('socket error #',WSAGetLastError);
    readln;
    exit;
  end;

Спасибо A.Truhin за замечание, код выше исправлен, и теперь проверяется возвращаемое значение функции send. Она возвращает количество переданных байт, а в случае ошибки -1, то есть SOCKET_ERROR.
Мы передали начало буфера и его длину. Так как наш сокет блокирующий, то всё, что написано после send, будет выполнено после того, как пройдёт запрос. А после этого нам предстоит ждать ответа :)

Reсv – получаем ответ

Мы знаем, что ответ должен быть, так как мы работаем с http протоколом. Поэтому сразу претендуем на ответ от сервера. Наш помощник – функция recv.

  repeat
    FillChar(Buffer2,SizeOf(Buffer2),0);
    d:=recv(Socket1,Buffer2,SizeOf(Buffer2),0);
    for i:=1 to d do write(Buffer2[i]);
  until d<=0;

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

Закроем сокет и подведём итог.

if CloseSocket(Socket1)<>0 then
  writeln('error closing socket');

Итог: winsock - это просто!
Скачать исходник!
И в заключение хочу отметить, что вес нашей программы всего 17Кб! Неплохо для работы с интернетом? :)

(c) crystalbit, http://parsers.info
Подпишись на RSS ленту, и я обещаю тебе много интересного материала по сокетам!

Похожие записи

• WinSock: Получение хоста по адресу (13)

[Матчасть]

Как оказалось, delphi нам уже всё подготовил. Мы будем использовать два объекта TStringList и, очевидно, TStringGrid.
У объекта TStringList есть свойство Delimiter (разделитель – англ.). А сам TStringList по сути своей – массив строк.
DelimitedText – string. Строка, присвоенная DelimitedText, разобьётся, согласно Delimiter, и у нас становится TStringList с элементами строки. Впрочем, тот же explode на php.
QuoteChar – это свойство нам сегодня не пригодится, но упомянуть стоит. Например, у нас есть строка «delimiter»;»delimitedtext»;»quotechar»;»tstringlist». Элементы в ней не только разделены точкой с запятой, но еще и заключены в кавычки. В этом случае Delimiter ставим как ;, а QuoteChar как «. И легким движением руки мы получаем список из ключевых слов данного поста :)
Хотел сначала написать, что функция explode на php так не может (ха-ха), а потом прочитал, что там есть готовая функция fgetcsv, Нагайченко Максим написал об этом в посте на своём блоге.

Готовим TStringGrid

Для будущей загрузки таблицы, в Object Inspector я изначально поставил ColCount=1, а FixedCols и FixedRows обратил в ноль.

Парсим csv

Допустим, у нас есть таблица c:\table.csv, которую нам предстоит загрузить в TStringGrid.
Наши действия: каждую строку построчно разбиваем на элементы с помощью вышеописанных свойств и вставляем в TStringGrid.
В примере я использовал второй TStringList для открытия файла. Для больших таблиц также неплохо будет использование стандартного построчного получения файла, перешедшего из паскаля (AssignFile, Reset, ReadLn), но сегодня акцент не на этом.

Код:

procedure TForm1.Button1Click(Sender: TObject);
var
  sdata, srow: TStrings;
  i:integer;
begin
  sdata:=TStringList.Create;
  srow:=TStringList.Create;
  srow.Delimiter:=',';
  sdata.LoadFromFile('c:\table.csv');
  StringGrid1.RowCount:=sdata.Count;
  for i:=0 to sdata.Count-1 do begin
    srow.DelimitedText:=sdata[i];
    if srow.Count>StringGrid1.ColCount then
      StringGrid1.ColCount:=srow.Count;
    StringGrid1.Rows[i].Assign(srow);
  end;
  srow.Free;
  sdata.Free;
end;

Небольшие пояснения: в sdata загружаем файл, строки из sdata по очереди парсим в srow, который каждый раз присваиваем следующей строке TStringGrid.

Про tsv и прочее

Для парсинга tsv свойству Delimiter нужно присвоить значение табуляции. Это девятый символ, #9, chr(9) – так можно записать. Согласно википедии, csv и tsv объединяет формат dsv – delimiter-separated values, собственно его мы сегодня и отпарсили.

(c) crystalbit, http://parsers.info
RSS поток – будь в курсе!

Похожие записи

• Построчный парсинг (24)
• Парсим даты апдейтов с главной pr-cy (103)
• Определяем WebMoney BL (85)
• Количество подстрок в строке. (3)

Сегодня рассмотрим вопрос о том, как перечислить все компоненты на форме. Например, как очистить все TEdit одним циклом, как изменить надписи на всех TLabel, как нажать все TButton :)
В заметке про создание кнопок с использованием TImage я уже испольовал данный приём, теперь рассмотрим подробнее.

0. Матчасть

У объекта TForm (а также других, на которых можно поставить, например, кнопку) есть массив Components. Очевидно, так мы можем обращаться ко всем объектам на форме.
Количество объектов – свойство ComponentCount. Первый объект имеет индекс 0, последний ComponentCount-1.

1. Просто перечислим имена компонентов

Запишем в Memo, другой наглядной реализации в голову не пришло

var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do
    Memo1.Lines.Add(Components[i].Name);
end;

Теперь в Memo1 у нас имена всех компонентов.

2. Конкретизируем задачу

Будем использовать операторы is и as, тут без них никак:

var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do
    if Components[i] is TLabel then
	  Memo1.Lines.Add((Components[i] as TLabel).Caption);
end;

Вот так просто мы получили все надписи на объектах TLabel. Теперь давай сделаем их невидимыми – пусть никто не прочитает :)

var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do
    if Components[i] is TLabel then
	  (Components[i] as TLabel).Visible:=False;
end;

3. Итог

Теперь мы крутые, и нам не нужно прописывать:

Label1.Visible:=False;
Label2.Visible:=False;
...

Наконец, хочу сделать картинку к этому посту в моём delphi блоге. Я поставил на форму в случайном порядке несколько TLabel и TEdit, поставил кнопку, по нажатию на которую написал:

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do
    if Components[i] is TLabel then
	    (Components[i] as TLabel).Caption:='http://parsers.info'
    else if Components[i] is TEdit then
      (Components[i] as TEdit).Text:='crystalbit';
end;

Запустил, нажал на неё. А результат смотри в начале этого поста :)

5. Замечание

Если используешь фреймы на форме, то этот механизм может не сработать.
Спасибо Алексею Тимохину

6. Вариант с рекурсией от JayDi

Подходит для фреймов

procedure FillChildComponentsList(const SourceComponent: TComponent;
  var ChildsList: TList);
var
  I: Integer;
begin
  //рекурсивный поиск дочерних компонентов
  for I := 0 to SourceComponent.ComponentCount - 1 do
  begin
    ChildsList.Add(SourceComponent.Components[I]);
    FillChildComponentsList(SourceComponent.Components[I], ChildsList);
  end;
end;  

procedure Tf_TestFrameComponents.Button_TestComponentsClick(Sender: TObject);
var
  FoundedComponentsList: TList;
  I: Integer;
  Comp: TComponent;
begin
  //получение списка компонетов
  FoundedComponentsList := TList.Create;
  FillChildComponentsList(Self, FoundedComponentsList);  

  //смена текста у всех лейблов
  for I := 0 to FoundedComponentsList.Count - 1 do
  begin
    Comp := FoundedComponentsList[I];
    if Comp is TLabel then
    begin
      (Comp as TLabel).Caption := 'Its work!';
    end;
  end;  

  FreeAndNil(FoundedComponentsList);
end;

(c) crystalbit, http://parsers.info
а еще на блоге есть rss-лента!

P.S. можно писать посты в блог, можно пытаться сделать ссылку во флеш, в любом случае надо усердно работать.

Похожие записи

• Параметр Sender в обработчиках событий (event handlers) на delphi. (10)
• Операторы as и is или «английский язык произошел от дельфи». (3)
• Sender: немного практики, или создаём свой стиль кнопок. (7)

Подготовка

У наших кнопок будет три состояния – нажата, не нажата, активна (наведена мышь).
Заранее подготовь три картинки, для трёх этих состояний, и помести в папку программы.
Создадим константы с именами наших картинок:

const
  IM_DOWN: string='down.bmp';
  IM_MAIN:  string='main.bmp';
  IM_HOVER: string='hover.bmp';

Ии, нам надо их менять, подготовимся:

procedure SetState(btn:TImage;vstate:string);
var
  vfile:string;
begin
  vfile:=ExtractFilePath(ParamStr(0))+vstate;
  try
    btn.Picture.LoadFromFile(vfile);
  except
  end;
end;

Здесь мы передаём функции имя файла картинки (из созданных констант) и указание на TImage, с которым нужно такое сотворить.

Так-с, поставим теперь на форму Image1, создадим ему следующие обработчики событий:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  SetState(Image1,IM_HOVER);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetState(Image1,IM_MAIN);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  SetState(Image1,IM_DOWN);
end;

Тут всё понятно (надеюсь): при нажатии, отжатии, наведении мышью. А как быть, когда мышь уходит?

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  SetState(Image1,IM_MAIN);
end;

Да, с одним TImage работает на ура. Только вот мерцает при движении мышью, это плохо, так ведь?

Тогда добавим еще четыре константы:

const
  BS_UP=1001;         //последнее событие было mouseup
  BS_DOWN=1002;       //последнее событие было mousedown
  BS_HOVER=1003;      //последнее событие было mousemove
  BS_FORM=1004;  //мышь двигается по форме

Куда мы будем их присваивать? Неверно, к свойству tag у TImage, оно зарезервировано специально для таких пожарных случаев.

Сразу приведу модифицированный код:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Image1.Tag<>BS_HOVER then
    SetState(Image1,IM_HOVER);
  Image1.Tag:=BS_HOVER;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Image1.Tag<>BS_UP then
    SetState(Image1,IM_MAIN);
  Image1.Tag:=BS_UP;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Image1.Tag<>BS_DOWN then
    SetState(Image1,IM_DOWN);
  Image1.Tag:=BS_DOWN;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Image1.Tag<>BS_FORM then
    SetState(Image1,IM_MAIN);
  Image1.Tag:=BS_FORM;
end;

Обобщение

Вот и настал тот момент… когда нам надо переходить от одного Image1 к любому TImage, на котором произошло событие. Если ты читал мой блог, то уже знаешь, что надо заменить Image1 на (Sender as TImage) во всех обработчиках событий у Image1.

А что делать при движении мышью по форме? Точно, надо перебрать все компоненты TImage на форме, полезный, кстати, навык:

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do begin
    if Components[i] is TImage then begin
      if (Components[i] as TImage).Tag<>BS_FORM then
        SetState((Components[i] as TImage),IM_MAIN);
     (Components[i] as TImage).Tag:=BS_FORM;
    end;
  end;
end;

Вроде всё чисто и ясно, могу про это потом отдельный пост написать.

Ну и назначим события при старте формы:

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to ComponentCount-1 do begin
    if Components[i] is TImage then begin
      (Components[i] as TImage).OnMouseDown:=Image1MouseDown;
      (Components[i] as TImage).OnMouseUp:=Image1MouseUp;
      (Components[i] as TImage).OnMouseMove:=Image1MouseMove;
    end;
  end;
end;

Итог

Теперь, сколько бы мы TImage не создали в проекте, столько у нас и будет кнопок :)

Иногда требуется подключить интернет, но возникают проблемы – много провайдеров, разные тарифы – как выбрать? Если ты в Москве, то воспользуйся ссылкой выше.

Ах, вот проектик – скачать
А вот rss лента – подписаться

Похожие записи

• Перечисление всех компонентов на форме (12)
• Параметр Sender в обработчиках событий (event handlers) на delphi. (10)
• Операторы as и is или «английский язык произошел от дельфи». (3)

1. As

Да, я в названии не опечатался. Когда я использую as и is, мне кажется, что я пишу сочинение на английском на свободную тему – даже получаются правильно построенные предложения :)
Оператор as – я бы его перевёл как «использовать как».
Примерчик: при нажатии на кнопку, написать на ней «нажато». Пускай мы не знаем, какая кнопка нажата, так как наше событие вызывают несколько кнопок.

procedure TForm1.Button1Click(Sender: TObject);
begin
  (Sender as TButton).Caption:='нажато';
end;

Мы используем Sender типа TObject как TButton, потому что мы заранее знаем, что это кнопка. Почему бы просто не написать Sender.Caption? Вот если у вызвавшего события компонента не будет такого свойства, то не имеет смысла. Впрочем, ошибка появится уже на этапе компиляции.
Можно и так:

procedure TForm1.Button1Click(Sender: TObject);
var
  vb: TButton;
begin
  vb:=Sender as TButton;
  vb.Caption:='нажато';
end;

Подводя итог, после as пишем тип, за который мы хотим принимать объект.

2. Is

А как нам быть, если мы не знаем, какого типа объект вызвал наш метод? Допутим, мы поставили еще и Label1 (TLabel) и на OnDblClick присвоили наш Button1Click. Sender as TButton – так для TLabel не получится. В runtime появится ошибка «invalid class typecast».
Ну что,

procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Sender is TButton) then
    (Sender as TButton).Caption:='нажато';
  if (Sender is TLabel) then
    (Sender as TLabel).Caption:='дважды нажато';
end;

Вот и всё, нет ошибки. Если говорить по матчасти, (Sender is TButton) возвращает true или false.

В ближайшем будущем хочется привести один замечательный пример, подпишись на rss ленту и узнаешь первым ;)

А я сегодня сдал зачёт по экологии)

(c) crystalbit, http://parsers.info

——-

Сердце Парижа, что это? Конечно же, Собор Парижской Богоматери, Notre Dame de Paris, Нотр Дам. Многие слышали о нём, многие наслышаны, многие рассматривали фотографии этого собора. Почему бы и не съездить?

Похожие записи

• Перечисление всех компонентов на форме (12)
• Параметр Sender в обработчиках событий (event handlers) на delphi. (10)
• Sender: немного практики, или создаём свой стиль кнопок. (7)

1. Твой пост достаточно полон, и сложно что-то написать, кроме как «хорошая работа». Я считаю это глупым, читаю пост и иду дальше.
2. В посте я узнал что-то новое, мне нужно это обдумать, даже перед тем, как сформулировать вопрос. Аналогично предыдущему, не хочу ставить себя в глупое положение. Прохожу мимо.
3. Я готов написать комментарий, но замечаю, что ты ответил только некоторым близким знакомым. Я не хочу быть высмеянным на публике.
4. Люди, комментирующие твои посты, любят ругаться, а я – нет. Я не уверен в своей храбрости сражаться с толпой.
5. Ты редко отвечаешь на комментарии. Поэтому просто нет смысла писать еще один.
6. Ты относишься к комментаторам, как к глупым. Я не настолько глуп, чтобы писать в твоём блоге.
7. Мне реально понравился твой пост и весь блог, но я очень устал или занят своими делами. Я отпишу в следующий раз, как буду проходить мимо.
8. Твои посты заканчиваются общим вопросом, типа «Что ты думаешь про теорию большого взрыва?». Вопрос слишком объемен, у меня просто нет времени на него ответить. Мне неудобно писать более короткий ответ.
9. Между мной и моим комментарием стена в виде авторизации. У меня и так много паролей, и мне не очень хочется добавить еще один в мой список.
10. Контент недостаточно свежий и интересный. Я читал об этом на дестке других блогов. Если комментировать, то расписывать всё заново.
11. Пост носит негативный характер. Это отпугивает.

Блоггер с ником Xager тоже поднимал эту тему в мае.
Почему многие блоги кажутся неживыми? Он приводит следующие причины:

1. Комментировать некому. Надо подниматься в топ :)
2. Материал не интересен, автор не интересен, блог не интересный. Надо брать пример с успешных людей в таком случае.
3. Непонятно. Совсем.
4. Нечего добавить. Смотри первую причину в предыдущем обзоре.
5. Ты не отвечаешь на комментарии, зачем тогда комментировать?
6. У вас ГС. Не знаю, что это такое) Xager, о приди и оставь комментарий!
7. Ты грубый. Плохой.
8. Нет смысла из SEO соображений. Если стоит nofollow, а может еще и noindex, то это грустно.

Пост от Xager – там найдешь некоторые советы.

(c) crystalbit, http://parsers.info
Комментируй! Гуляем!

Похожие записи

• Google инструменты для веб-мастеров. (18)

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

Давным-давно, в царстве delphi
Жил-был объект по имени Sender

[Обработчики событий и Sender]

Посмотрим на обработчик события OnClick кнопки Button1:

procedure TForm1.Button1Click(Sender: TObject) ;
begin
  ...
end;

Метод Button1Click указывает на объект Sender типа TObject. Каждый обработчик в delphi обязательно имеет параметр Sender. Функция Button1Click вызывается для события OnClick каждый раз, когда нажимается кнопка.

Параметр Sender ссылается на компонент, который вызвал метод. Если ты нажмёшь на Button1, выполнится метод Button1Click. А ссылка или указатель на объект Button1 передастся в параметре Sender.

[На практике]

Правильное использование параметра Sender может придать неимоверную гибкость нашему коду (так же, как и фильтр косой иногда позволяет уменьшить размер конструкции из труб). Параметр Sender даёт нам знать, какой компонент возбудил наше событие. (возбудил событие – запомню) Это облегчает использование одного обработчика для двух разных компонентов.

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

Для того, чтобы сделать вышеизложенное в Delphi, нужно следующее:

• Напиши обработчик события для первого объекта (почему бы не на кнопку в SpeedBar’е?)
• Выдели еще объекты, а может и несколько объектов (почему бы не MenuItem1, а?)
• В Object Inspector найди Events
• Рядом с нужным событием выбери в списке уже созданный обработчик (Delphi предложит все совместимые функции на форме)

Вот мы с тобой и создали единственный метод, который обрабатывает события OnClick на кнопке и пункте меню. Теперь нам только и остаётся, что различать, какой компонент вызвал наш метод. К примеру, у тебя мог получиться такой код:

procedure TForm1.Button1Click(Sender: TObject) ;
begin
  {общий код для пункта меню и кнопки}
  ...
  {а вот и разделение труда:}
  if Sender = Button1 then
   ShowMessage('Button1 клац!')
  else if Sender = MenuItem1 then
   ShowMessage('MenuItem1 клац!')
  else
   ShowMessage('??? клац!') ;
end;

В общих чертах, мы сравниваем Sender с компонентом.

Замечание:
Второй else в конструкции if-then-else для тех случаев, когда событие вызвано не Button1 и не MenuItem1. Но кто же еще мог вызвать наш метод? Попробуй так, поставь только еще и Button2:

procedure TForm1.Button2Click(Sender: TObject) ;
begin
   Button1Click(Button2) ;
   {будет сообщение '??? клац!'}
end;

(c) Delphi Programming – http://delphi.about.com
(c) crystalbit – http://parsers.info

В следующей части данной статьи рассказывается про такие операторы, как as и is, скоро появится у меня на блоге.
Подпишись на rss ленту, чтобы не упустить момент;)

Похожие записи

• Перечисление всех компонентов на форме (12)
• Операторы as и is или «английский язык произошел от дельфи». (3)
• Sender: немного практики, или создаём свой стиль кнопок. (7)