Трехмерные формы с изменяющимися размерами

Попробуйте нижеприведенные обработчики событий WMNCPaint и WMNCHitTest.

При этом форма должна иметь свойство BorderStyle равным Sizeable, так как код использует область границ для создания 3D эффекта и предоставляет пользователю возможность изменения размера формы.

Для запрещения изменения размеров формы вы должны включить обработчик события WMNCHitTest, для обратного эффекта не включайте его в ваш код.


procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  DC: HDC;
  Frame_H: Integer;
  Frame_W: Integer;
  Menu_H: Integer;
  Caption_H: Integer;
  Frame: TRect;
  Extra: Integer;
  Canvas: TCanvas;
begin
  { Задаем значения некоторым параметрам окна }
  Frame_W := GetSystemMetrics(SM_CXFRAME);
  Frame_H := GetSystemMetrics(SM_CYFRAME);
  if (Menu <> nil) then
    Menu_H := GetSystemMetrics(SM_CYMENU)
  else
    Menu_H := -1;
  Caption_H := GetSystemMetrics(SM_CYCAPTION);
  GetWindowRect(Handle, Frame);
  Frame.Right := Frame.Right - Frame.Left - 1;
  Frame.Left := 0;
  Frame.Bottom := Frame.Bottom - Frame.Top - 1;
  Frame.Top := 0;
  { Позволяем нарисовать стандартные границы формы }
  inherited;
  { Перерисовываем область границ в 3-D стиле }
  DC := GetWindowDC(Handle);
  Canvas := TCanvas.Create;
  try
    with Canvas do
    begin
      Handle := DC;
      { Левая и верхняя граница }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Left, Frame.Top),
        Point(Frame.Right, Frame.Top)]);
      { Правая и нижняя граница }
      Pen.Color := clWindowFrame;
      PolyLine([Point(Frame.Left, Frame.Bottom),
        Point(Frame.Right, Frame.Bottom),
          Point(Frame.Right, Frame.Top - 1)]);
      { Левая и правая граница, 1 пиксел скраю }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
        Point(Frame.Left + 1, Frame.Top + 1),
          Point(Frame.Right - 1, Frame.Top + 1)]);
      { Правая и нижняя граница, 1 пиксел скраю }
      Pen.Color := clBtnFace;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
        Point(Frame.Right - 1, Frame.Bottom - 1),
          Point(Frame.Right - 1, Frame.Top)]);
      { Разность области изменяемых границ }
      for Extra := 2 to (GetSystemMetrics(SM_CXFRAME) - 1) do
      begin
        Brush.Color := clBtnFace;
        FrameRect(Rect(Extra, Extra, Frame.Right - Extra + 1, Frame.Bottom -
          Extra + 1));
      end;
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame_W - 1, Frame_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
      { Левая и верхняя граница области заголовка }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame.Right - Frame_W + 1, Frame_H + Caption_H + Menu_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
    end;
  finally
    Canvas.Free;
    ReleaseDC(Handle, DC);
  end; { try-finally }
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
  HitCode: LongInt;
begin
  inherited;
  HitCode := Msg.Result;
  if ((HitCode = HTLEFT) or (HitCode = HTRIGHT) or
    (HitCode = HTTOP) or (HitCode = HTBOTTOM) or
    (HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or
    (HitCode = HTTOPRIGHT) or (HitCode = HTBOTTOMRIGHT)) then
  begin
    HitCode := HTNOWHERE;
  end;
  Msg.Result := HitCode;
end;

Добавлено: 22 Февраля 2019 07:41:14 Добавил: Андрей Ковальчук

Делим код пополам или представление по шаблону в PHP


Зачем все это? - возмущенно спросил Артём, широко раскрыв глаза. У нас и так все прекрасно работает! Я знаю, где мне надо поменять код, чтобы новости отображались в три колонки, а не в две. А Тане я потом покажу, где поменять теги...
Если вы понимаете, какие проблемы у Тани с Артёмом, то это уже хорошо. Как некоторые догадываются Артём - PHP программист, Таня - дизайнер-верстальщик. У них есть общая проблема - файл, который формирует ленту новостей. Редактируют они его по очереди и сам черт ногу сломит в нём. А все потому, что PHP код Артёма уже давно зависит от HTML кода Татьяны и наоборот. И нет им покоя длительное время, если что-то надо поменять в этом файле. Если бы Артём с Татьяной знали о представлении по шаблону, то они бы не тратили кучу нервов и времени на столь простую функцию.

Итак, что же такое шаблонизация, шаблонизаторы, наконец, Template View, зачем они нужны, как их делать и как ими пользоваться? Все очень просто...

Представление по шаблону (Template View) или шаблонизация - это механизм, позволяющий заменять в статической HTML странице ее динамические части, то есть, простым языком говоря, в Таниной HTML страничке заменять данные, генерируемые PHP кодом Артёма. При этом Артём работает со своим файлом, в котором не видит ни одного Таниного тега, а Таня со своим. С этим механизмом Артёму и Тане очень удобно. Им больше не режет глаза чужой листинг, и их идеи в построении кода не зависят друг от друга. Таким образом, выделим два основных, почти смежных, достоинства шаблонизации:

Разделение и удобство работы дизайнера и кодера над одним приложением.
Отделение представления интерфейса пользователя от логики работы программы.
Даже если вы сами работаете над приложением, вам, может быть, намного удобнее будет разделять работу над видом вашего сайта и его логикой работы.

Для начала маленький пример:

Listing №1 (PHP)

<?php
  date_default_timezone_set('Europe/Kiev');
  $UserMessage = 'Артём';
  if (date('md') === '0509') {
    $UserMessage .= ' С Днём Победы!';
  }
?>
<html>
<head>
<title>Пример1</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
Привет, <?php echo $UserMessage; ?>
</body>
</html>

Поспешу вас обрадовать - перед вами простейший код, выполняющий шаблонизацию. Да, может вы и не знали, но PHP сам по себе отличный шаблонизатор. Как видно из примера, в результате выполнения сценария в статической части (шаблоне - код черного цвета) будет заменена ее динамическая часть, которую PHP сгенерирует с помощью команды echo. Это самый простой случай привожу для того, чтобы вы запомнили, что PHP - сам по себе шаблонизатор. Но как бы там ни было, такой подход не решает проблемы Артёма и Татьяны.

Разделим код на два файла: model.php и template.php. Первый отдадим Артёму, а второй Татьяне.

model.php

Listing №2 (PHP)
<?php
  date_default_timezone_set('Europe/Kiev');
  $UserMessage = 'Артём';
  if (date('md') === '0509') {
    $UserMessage .= ' С Днём Победы!';
  }
  include 'template.php';
?>

template.php

Listing №3 (PHP)
<html>
<head>
<title>Пример2</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
Привет, <?php echo $UserMessage; ?>
</body>
</html>

Как же теперь обрадовался Артём - нет ни одного Татьяниного тега. Чистый PHP код. Татьяне тоже повезло. Хотя ее немного смущает кусочек PHP кода в теле страницы, но она не сильно обращает на это внимание, потому как знает, что в этом месте просто будет написано сообщение пользователю.

Заметьте, обычным разделением кода мы намного облегчили работу Артёма и Татьяны. Теперь статическая часть страницы, то есть интерфейс пользователя отделен от логики работы приложения. Не только Татьяна, но и любой другой человек, не владеющий программированием на PHP, но имеющий опыт в дизайне и верстке, теперь легко сможет изменить внешний вид сайта. Артем в любой момент может поменять логику работы приложения, например, заменив ее на поздравление "С Новым Годом". При этом ему не будет мозолить глаза вся эта Татьянина писанина и, пока Таня ваяет дизайн, он быстренько все поменяет и пойдет домой смотреть Футураму.

Таким образом мы отделили интерфейс от логики работы скрипта. Мы создали статический шаблон (файл template.php), в который поместили маркер PHP кода (<?php echo $UserMessage; ?>), обращающийся к скрипту для получения динамической информации - строки с приветствием пользователя. Такой метод шаблонизации называется native (родной) или прямой, потому как команда include 'template.php' фактически вставила template.php в model.php и PHP шаблонизировал все сам по себе, заменив свой вызов в шаблоне значением переменной $UserMessage.

Раз уж у нас есть такой хороший способ шаблонизации, то спрячем логику его работы в простой класс:

class.view.php

Listing №4 (PHP)
<?php
/**
 * Класс шаблонизатор
 */
class View {
  /**
   * Файл шаблона
   * @var string
   */
  private $_File;
  /**
   * Массив переменных-маркеров шаблона
   * @var array
   */
  private $_Vars;
  /**
   * Конструктор, инициализируем свойства класса
   */
  public function __construct()
  {
    $this->_File = '';
    $this->_Vars = array();
  }
  /**
   * Устанавливает файл шаблона
   * @param string $File
   */
  public function SetTemplate($File)
  {
    $this->_File = $File;
  }
  /**
   * Связывает переменные скрипта с переменными-маркерами
   * @param string $VarName
   * @param string $VarValue
   */
  public function AssignVar($VarName, $VarValue)
  {
    if ($VarName !== '') {
      $this->_Vars[$VarName] = $VarValue;
    }
  }
  /**
   * Отображает шаблон
   */
  public function Display()
  {
    if (file_exists($this->_File)) {
      extract($this->_Vars, EXTR_PREFIX_ALL, '');
      include $this->_File;
    }
  }
}
?>

Теперь попробуем его использовать. Поместим наш класс в файл class.view.php и перепишем классы model.php и template.php:


template.php

Listing №5 (PHP)
<html>
<head>
<title>Пример3</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
Привет, <?php echo $_UserMessage; ?>
</body>
</html>


model.php

Listing №6 (PHP)
<?php
require_once 'class.view.php';
date_default_timezone_set('Europe/Kiev');
$UserMessage = 'Артём';
if (date('md') === '0509') {
  $UserMessage .= ' С Днём Победы!';
}
//Создаем объект представления интерфейса
$Veiw = new View;
//Устанавливаем шаблон представления
$Veiw->SetTemplate('template.php');
//Установка значения переменной-маркера сообщения пользователю
$Veiw->AssignVar('UserMessage', $UserMessage);
//Отображение интерфейса
$Veiw->Display();
?>


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

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

class.view.php

Listing №7 (PHP)
<?php
/**
 * Класс шаблонизатор
 */
class View {
  /**
   * Файл шаблона
   * @var string
   */
  private $_File;
  /**
   * Массив переменных-маркеров шаблона
   * @var array
   */
  private $_Vars;
  /**
   * Конструктор, инициализируем свойства класса
   */
  public function __construct()
  {
    $this->_File = '';
    $this->_Vars = array();
  }
  /**
   * Устанавливает файл шаблона
   * @param string $File
   */
  public function SetTemplate($File)
  {
    $this->_File = $File;
  }
  /**
   * Связывает переменные скрипта с переменными-маркерами
   * @param string $VarName
   * @param string $VarValue
   */
  public function AssignVar($VarName, $VarValue)
  {
    if ($VarName !== '') {
      $this->_Vars[$VarName] = $VarValue;
    }
  }
  /**
   * Отображает шаблон
   */
  public function Display()
  {
    if (file_exists($this->_File)) {
      include $this->_File;
    }
  }
  /**
   * Функция доступа к элементу массива
   * переменных-маркеров шаблона
   * @param string $Varname
   * @return mixed
   */
  public function __get($VarName)
  {
    if (array_key_exists($VarName, $this->_Vars)) {
      return $this->_Vars[$VarName];
    }
    return NULL;
  }
}
?>


И немного изменим шаблон:


template.php

Listing №8 (PHP)
<html>
<head>
<title>Пример4</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
Привет, <?php echo $this->UserMessage; ?>
</body>
</html>

Все стало лучше и проще. Заметьте, в файле model.php мы ничего не меняем - опять же, благодаря тому, что мы скрыли сложности реализации шаблонизации в классе. Скрывайте сложность - это избавит вас от многих проблем и не только при программировании на PHP.

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

Теперь самое время вспомнить наших Артёма с Татьяной и познакомить вас с еще одним методом шаблонизации - методом замены. Как бы мы не старались угодить Артёму с его скриптом, Татьяну все же немного напрягает присутствие чужого кода в своем милом HTML 4.01 Transitional. Дело в том, что полностью Татьяну удовлетворить нельзя, но мы можем максимально приблизить такой момент как раз с помощью метода замены. Для этого нам понадобиться что? Правильно - новый класс.

class.view.php

Listing №9 (PHP)
<?php
/**
 * Класс шаблонизатор
 */
class View {
  /**
   * Файл шаблона
   * @var string
   */
  private $_File;
  /**
   * Массив переменных маркеров шаблона
   * @var array
   */
  private $_Vars;
  /**
   * Конструктор, инициализируем свойства класса
   */
  public function __construct()
  {
    $this->_File = '';
    $this->_Vars = array();
  }
  /**
   * Устанавливает файл шаблона
   * @param string $File
   */
  public function SetTemplate($File)
  {
    $this->_File = $File;
  }
  /**
   * Связывает переменные скрипта с переменными-маркерами
   * @param string $VarName
   * @param string $VarValue
   */
  public function AssignVar($VarName, $VarValue)
  {
    if ($VarName !== '') {
      $this->_Vars[$VarName] = $VarValue;
    }
  }
  /**
   * Отображает шаблон
   */
  public function Display()
  {
    echo $this->_Prepare();
  }
  /**
   * Загружает шаблон и
   * заменяет в нем маркеры замены
   */
  private function _Prepare()
  {
    $Content = '';
    if (file_exists($this->_File)) {
      $Content = file_get_contents($this->_File);
      foreach ($this->_Vars as $VarName=>$VarValue) {
        $Content = str_replace('{' . $VarName . '}', $VarValue, $Content);
      }
    }
    return $Content;
  }
}
?>

Посмотрим теперь на наш шаблон:


template.php

Listing №10 (HTML)
<html>
<head>
<title>Пример5</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body>
Привет, {UserMessage}
</body>
</html>


Да он уже и не PHP совсем! Хотя в нем и нет вообще PHP кода, в нем присутствует некий псевдокод. Но для Татьяны, дизайнера-верстальщика, это просто набор символов {UserMessage}, который довольно прост в восприятии и практически ее не отвлекает. Разве что она знает, что там, в итоге, будет имя пользователя.

Стоит заметить, что данная конструкция не разрушает никакие HTML теги и ее удобно наблюдать в WYSIWYG редакторах, в отличие от шаблонов, реализованных для native метода, которые часто могут исказить вид шаблона в "неподготовленных" к этому редакторах. Заметно, что метод замены намного удобнее для Тани. Да и Артём, как обычно, не сильно напрягается. Таким образом, мы практически полностью отделили Танин HTML код от PHP кода Артёма, а также логику вида интерфейса от логики работы приложения. Теперь, с помощью такого шаблонизатора можно написать приложение на PHP, описать маркеры в шаблонах и тогда любой дизайнер, даже понятия не имеющий, что есть PHP, сможет эффективно поработать.

Но у всего хорошего всегда есть какие-то недостатки. И этот метод не исключение. Во-первых, метод замены несколько, а порой и намного, медленнее native метода. Это естественно - мы же считываем файл с диска, ищем и заменяем в нем одни значения на другие. Во-вторых, при написании всего кода, можно теоретически совершит больше ошибок. Например, не связав переменную скрипта с переменной-маркером, мы можем получить надпись "Привет , {UserMessage}", в то время как в предыдущем подходе мы просто увидим "Привет, ". Я думаю, первое выглядит похуже. Вот такими недостатками мы можем платить за комфорт Татьяны. Поэтому, Татьяны со знаниями базовых конструкций PHP обычно ценятся подороже обычных Татьян. Но не надо так сильно останавливать внимание на недостатках. В конце концов, решающим фактором является не количество недостатков, а относительная их доля в количестве достоинств. Существует масса классов использующих, именно этот метод. Одним из самых распространенных является Smarty. Его используют миллионы сайтов и не замечают данных недостатков.

То же самое относиться и к native методу. Он не избавляет нас от PHP кода в шаблоне. Зато он намного быстрее и предоставляет более эффективное управление логикой представления, благодаря именно PHP коду внутри шаблона. Не надо стараться извлечь весь PHP код из шаблона - главное разделить логику представления и приложения. И если PHP код в шаблоне управляет логикой представления, то это есть норма и ничего более менять уже не надо. Разве что необходимость в эффективной работе дизайнеров или требования заказчика или личные предпочтения заставят вас все же использовать метод замены.

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

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

Учимся работать с Excel файлами

Всем привет! Сегодня наш урок будет посвящен использованию Excel'я в Delphi. А именно я рассажу как вывести табличку из Excel'я в компонент DbGrid.

Итак начинаем.....

Таблица содержит 3 столбика: Имя, Фамилия, Должность. Обратите внимание что таблицу я создал на листе с Именем Лист1 (в дальнейшем нам это пригодиться). Так далее, я добавил в неё первую запись (Олег, Иванов, Менеджер). Всё начальные приготовления завершены, осталось только сохранить наш документ, я сохраню его на диске C:\ с именем 2.xls

Теперь открываем Delphi и кидаем на форму 4 компонента: ADOConnection, ADOQuery с закладки ADO, DataSource с закладки Data Access и DBGrid с закладки DataControls. Для того что-бы вывести документ Excel в компонент DbGrid нам нужно с начала подключиться к этому документу, для этих целей будем использовать компонент ADOConnection. Выделяем его и в свойстве ConnectionString пишем вот такой код

Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\2.xls;Extended Properties=Excel 8.0;


В Свойстве LoginPromt и Connected установите значение false.

Далее у нас на очереди компонент DataSource, В Свойство DataSet поставте ADOQuery1.
А в компоненте ADOQuery свойство Connection установите на ADOConnection1.

Ну что со связями между компонентами вроде бы разобрались, теперь добавьте на форму 2 Компонента Edit и один компонент Button с закладки Standart. В первом Edit'e будет храниться путь до excel файла,
во втором edit'e мы будем писать SQL запрос, а при нажатии на кнопку программа будет подключаться к Excel файлу и выводить таблицу в компонент DbGrid.

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


procedure ConnectToExcel;  

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

Delphi автоматически генерирует нам шаблончик для будущей процедуры.


procedure TForm1.ConnectToExcel;  
begin  
  
end;  
end; 

Посмотрите теперь как должна выглядеть эта процедура и допишите не достающие строки.


procedure TForm1.ConnectToExcel;  
var strConn: widestring;  
begin  
strConn:='Provider=Microsoft.Jet.OLEDB.4.0;' +  
'Data Source=' +Edit1.Text+ ';' +  
'Extended Properties=Excel 8.0;';  
AdoConnection1.Connected:=False;  
AdoConnection1.ConnectionString:=strConn;  
try  
AdoConnection1.Open;  
except  
ShowMessage('Не могу соединиться с Excel книгой, которая расположена по адресу: '+Edit1.Text+' !');  
raise;  
end;  
end;  

С помощью этой процедуры мы будем устанавливать соединение между Excel файлом и Нашей программой.

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


procedure FetchData;  

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

Полный листинг процедуры:


procedure TForm1.FetchData;  
begin  
ConnectToExcel;  
AdoQuery1.Close;  
AdoQuery1.SQL.Text:=Edit2.Text;  
try  
AdoQuery1.Open;  
except  
ShowMessage( 'Не могу выполнить Sql запрос ' + Edit1.Text +'!');  
raise;  
end;  
end;  

Двигаемся дальше, создаем обработчик событий OnClick на кнопке.
Между begin ... end пишем имя второй функции: FetchData;

Все запускаем программу, в первом Edit'e прописываем полный путь до нашего excel документа (у меня это C:\2.xls), а во втором Edite пишем SQL запрос на выборку всех полей из таблицы Лист1:


SELECT * FROM [Лист1$]  

Жмем на кнопку.., ОПА табличка вывелась в компонент DBGRID

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

Создание непрямоугольных форм в Delphi

Немного о непрямоугольных формах... Кажется, весь мир сошёл с ума по таким формам; все форумы пестрят вопросами на эту тему :-) Есть ли сложности при создании непрямоугольной формы? Нет... Почти... Дело в том, что задать внешний вид формы можно, вызвав всего лишь одну функцию SetWindowsRgn.

SetWindowsRgn(Form1.Handle, True);
Правда, перед этим потребуется создать подходящий регион. Большинство из тех, кто работает на Delphi, не знают, что такое регион, главным образом потому, что эта штука не нашла своего отражения в VCL. :-)

Документация утверждает, что регион, это "прямоугольник, многоугольник, эллипс или комбинация двух или более фигур из приведённого списка". Регионы используются для "заливки, отсечения (то, что по английски называется clipping)" и других, не менее полезных операций.

Для создания регионов существуют такие функции (с очевидным назначением), как CreateRectRgn, CreateEllipticRgn, CreatePolygonRgn и несколько других. Объединять регионы между собой можно при помощи функции CombineRgn.

На этом теоретическая часть могла бы быть закончена, если бы не одно "но"... Это "но" я процитирую отдельно... :-)

Но ведь чаще всего непрямоугольную форму требуется построить на базе растровой картинки, задав для неё прозрачный цвет! Как быть?

Это правда. Насколько мне известно, Windows не умеет этого делать, то есть в ней нет функции CreateBitmapRgn. Тем не менее, можно создавать и такие регионы. Для этого необходимо пробежаться по всей картинке сверху вниз, в каждой строчке найти непрозрачные области и сделать из них прямоугольные регионы (эти прямоугольники будут высотой в 1 пиксель). Затем мы объединяем эти регионы, и, вуаля — вот он, искомый регион!

Готов поспорить, вы думаете, что это слишком сложно... :-) Проверяем...


function BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;  
var  
  X, Y: Integer;  
  XStart: Integer;  
begin  
  Result := 0;  
  with Bitmap do  
    for Y := 0 to Height - 1 do  
    begin  
    X := 0;  
    while X < Width do  
    begin  
      // Пропускаем прозрачные точки  
      while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do  
        Inc(X);  
      if X >= Width then  
        Break;  
      XStart := X;  
      // Пропускаем непрозрачные точки  
      while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do  
        Inc(X);  
      // Создаём новый прямоугольный регион и добавляем его к региону всей картинки  
      if Result = 0 then  
        Result := CreateRectRgn(XStart, Y, X, Y + 1)  
      else  
        CombineRgn(Result, Result, CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);  
    end;  
  end;  
end;  

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

type  
TFormMain = class(TForm)  
private  
  { Private declarations }  
  procedure WMLButtonDown(var Msg: TMessage); message WM_LBUTTONDOWN;  
public  
  { Public declarations }  
end;  

В разделе реализации эта функция выглядит так:

procedure TFormMain.WMLButtonDown(var Msg: TMessage);  
begin  
  Perform(WM_NCLBUTTONDOWN, HTCAPTION, Msg.LParam);  
end;  

Форма посылает самой себе сообщение WM_NCLBUTTONDOWN с wParam равным HTCAPTION, то есть эмулирует ситуацию, когда пользователь нажимает левую кнопку мыши на заголовке формы. После этого форму можно спокойно перемещать за всю её область.

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

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

Сохранение данных приложения и пользователя

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

Например, в Windows для сохранения специфических для приложения файлов, таких как INI-файлы, файлы состояния программы, временные файлы и т.п., должен быть использован каталог "Application Data".

Крайне нежелательно использовать жёстко прописанные пути вроде "C:\Program Files". При сохранении файлов в этом каталоге, приложение вряд ли будет корректно работать в других версиях Windows, потому что этот путь может быть изменён в следующих версиях Windows, либо пользователь может установить ОС на другой диск. К тому же, Windows Vista может не дать доступ ко многим каталогам. Даже пользователю с правами администратора.

WinAPI-функция SHGetFolderPath
Функция SHGetFolderPath определенна в модуле SHFolder. SHGetFolderPath возвращает полный путь к указанному специальному каталогу по его идентификатору.

Ниже приведена функция-обёртка для SHGetFolderPath, чтобы было проще получить стандартные каталоги (для всех пользователей или только для текущего пользователя).


uses SHFolder;  
...  
function GetSpecialFolderPath(folder : integer) : string;  
const  
  SHGFP_TYPE_CURRENT = 0;  
var  
  path: array [0..MAX_PATH] of char;  
begin  
  if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,@path[0])) then  
    Result := path  
  else  
    Result := '';  
end;  

Теперь создадим приложение для использования функции SHGetFolderPath:

Положим на форму TRadioGroup ("RadioGroup1");
Положим на форму TLabel ("Label1")
Добавим пять элементов в RadioGroup (свойство Items):
"[Текущий пользователь]\My Documents"
"All Users\Application Data"
"[User Specific]\Application Data"
"Program Files"
"All Users\Documents"
Добавим обработчик события OnClick для RadioGroup.



//RadioGroup1 OnClick  
procedure TForm1.RadioGroup1Click(Sender: TObject);  
var  
  index : integer;  
  specialFolder : integer;  
begin  
  if RadioGroup1.ItemIndex = -1 then Exit;  
  index := RadioGroup1.ItemIndex;  
  case index of  
    //[Current User]My Documents  
    0: specialFolder := CSIDL_PERSONAL;  
    //All UsersApplication Data  
    1: specialFolder := CSIDL_COMMON_APPDATA;  
    //[User Specific]Application Data  
    2: specialFolder := CSIDL_LOCAL_APPDATA;  
    //Program Files  
    3: specialFolder := CSIDL_PROGRAM_FILES;  
    //All UsersDocuments  
    4: specialFolder := CSIDL_COMMON_DOCUMENTS;  
  end;  
  Label1.Caption := GetSpecialFolderPath(specialFolder) ;  
end;  

Примечание: "[Текущий пользователь]" - это имя пользователя, сеанс которого в данный момент активен в Windows.

Функция SHGetFolderPath является более расширенным вариантом функции SHGetSpecialFolderPath.

Программа не должна сохранять свою информацию (временные файлы, пользовательские настройки, файлы конфигурации приложения, и т.д.) в каталоге My Documents (Мои документы), либо в каталоге самого приложения (т.е. в одном из подкаталогов Program Files). Следует использовать специальный каталог в Application Data, отведённый именно для Вашего приложения. Как правило, его имя совпадает с именем каталога программы в Program Files).

Всегда создавайте подкаталог только в тех путях, которые возвращает функция SHGetFolderPath! Как правило, каталог создаётся такой: "\Application Data\Название компании\Название продукта\Версия продукта".

Пример программы с использованием функции, описанной в статье, можно загрузить здесь.

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

Создание компонентов в Run-Time

Итак, рассмотрим на первый взгляд сложный вопрос о создании компонентов в Run_time (то есть во время работы программы). Но на самом деле этот вопрос довольно просто решается.

Давайте вместе попробуем написать код, чтобы при нажатии на кнопку на форме появлялось текстовое поле с каким-нибудь текстом. Для этого надо проделать следующие действия: объявить переменную необходимого вам типа компонента, в нашем случае TEdit, затем необходимо описать процедуру Create для нашей переменной, задать обязательное свойство Parent (то есть где появится наш компонент), ну и установить необязательные параметры типа высоты, ширины и т.д. Лучше разбираться на конкретном примере, так что смотрите какой у меня получился код:


procedure TForm1.Button1Click(Sender: TObject);  
var x:TEdit; // объявляем переменную типа TEdit  
begin  
x:=TEdit.create(self);// создаем экземпляр компонента  
x.parent:=form1;// текстовое поле появится на форме   
x.left:=10;  
x.top:=10;  
x.Width:=250;  
x.Text:='Привет компонент появился сам!!!';  
end;  

Как вы видите все очень просто. Поупражняйтесь с различными параметрами.

Процессы создания визуальных и невизуальных компонентов несколько отличаются (последний попроще будет). Поскольку Edit мы уже создали (а это как раз визуальный компонент), теперь будем создавать невизуальный компонент, например FontDialog. Поставьте на форму еще кнопку. Обработчик события OnClick может выглядеть так:


procedure TForm1.Button2Click(Sender: TObject);  
var y:TFontDialog; // объявляем переменную типа TFontDialog  
begin  
y:=TFontdialog.Create(self);  
y.Execute; //только для демонстрации. Показать что работает.  
end;   

Вы свободно можете изменять любые свойства компонента, созданного во время работы приложения.

Поскольку само Memo сортировать данные не умеет, то нам придется во время работы программы создать какую-нибудь переменную абстрактного класса TStringList (этот класс сортировать умеет), затем присвоить этому классу строки из Memo, отсортировать их и присвоить их обратно Memo. Поставим еще одну кнопку на форму, которая будет запускать процесс. Код получится примерно таким:


procedure TForm1.Button3Click(Sender: TObject);  
var t:TStringList;  
begin  
t:=TStringList.Create; //создаем  
t.AddStrings(memo1.lines); //присваиваем переменной t строки из Memo  
t.Sort; // сортируем  
memo1.Clear;  
memo1.Lines.AddStrings(t); // присваиваем memo уже отсортированные строки  
end;  

Теперь рассмотрим еще один вопрос, касающийся создания компонентов в Run-time. Допустим вам надо создать 20 полей для ввода текста (Edit) и еще десять меток (Label), не будете же вы 20 раз писать одно и тоже для каждого edit'a. В этой ситуации есть очень элегантный выход: воспользоваться массивом компонентов. В общем виде объявление массива компонентов может выглядеть так: имя_переменной:array[нижний_индекс..верхний_индекс] of тип_компонента. Теперь поупражняемся в этом. Создайте новое приложение. На форму поместите только кнопку. Обработчик события OnClick которой у меня получился таким:


procedure TForm1.Button1Click(Sender: TObject);  
var a:array[1..20] of TEdit; // массив элементов Edit  
      b:array[1..10] of TLabel; //массив меток  
      i,j:integer;  
begin  
 for i:=1 to 20 do begin  
 a[i]:=TEdit.create(self);  
 a[i].parent:=form1;  
 a[i].left:=10;  
 a[i].text:='элемент # '+inttostr(i);  
 a[i].top:=i*20;  
end;  
for j:=1 to 10 do begin  
 b[j]:=TLabel.create(self);  
 b[j].parent:=form1;  
 b[j].left:=200;  
 b[j].Caption:='элемент # '+inttostr(j);  
 b[j].top:=j*30;  
end;  
end;  

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

Автор: Михаил Христосенко

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

Создание заставок для ваших программ

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

Откройте какое-нибудь свое приложение, к которому вы хотите добавить заставку, или создайте новое (на чистом проще разбираться). Теперь необходимо добавить в наш проект еще одну форму, которая будет заставкой. Для этого нажмите File->New Form и Дельфи создаст вам новую форму. Измените ее размеры как вам хочется. Потом установите свойство Border Style вашей формы в bsNone (у формы не будет заголовка и системных кнопок), установите свойство Visible в false. Свойтсво Position должно быть poScreenCenter - это значит, что форма появится по центру экрана. И чтобы не перепутать эту форму ни с какой другой задайте ей имя Logo.

Настройка формы заставки произведена, теперь необходимо сделать, чтобы по щелчку мышкой по этой форме или после нажатия клавиши или по истечении 5 секунд форма-заставка закрывалась. Для этого установите на форму Timer, его свойству Interval задайте значение 5000 (форма будет закрываться через 5 секунд). В обработчик события OnTimer напишите всего одно слово: Close;

В обработчик события OnClick для формы-заставки напишите тоже самое. Установите свойство формы KeyPreview в true (это делается для того, чтобы при нажатии любой клавиши вначале реагировала форма, а затем тот элемент, который был в фокусе в момент нажатия). А в обработчик события OnKeyPress (для формы-заставки конечно же) опять-таки напишите close;

Форма-заставка готова полностью и теперь необходимо, чтобы она запускалась перед главной формой. Для этого сделайте активной вашу главную форму, перейдите на вкладку Events в Object Inspector'e и выберите событие OnShow. В обработчике этого события надо написать следующее:


logo.showmodal;  

Меня иногда спрашивают, чем отличаются процедуры show и showmodal. У них только одно принципиальное различие: если форма открылась методом Showmodal, то пока она не закроется пользователь не сможет взаимодействовать с остальными формами приложения. А если форма была открыта методом Show, то пользователь легко может перейти к любой форме приложения.

Итак, форма-заставка готова. Теперь мы слегка ее усовершенствуем. Добавим такую же штуку, как в формах-заставках Microsoft Office, а именно на форме будет показываться имя пользователя и организация. Для этого разместите на форме-заставке две метки (Label). Первую назовите UserName, а вторую - Organization. Чтобы это сделать мы воспользуемся реестром (тас вообще очень много интересного можно найти). Теперь откройте обработчик события OnCreate для формы-заставки и объявите там переменную R типа TRegistry, а в раздел Uses всей программы добавьте Registry. Теперь нам нужно создать объект R :


R:=TRegistry.Create;  
R.RootKey:=HKEY_LOCAL_MACHINE;  
//именно здесь эта информация хранится  
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);  

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


UserName.Caption:=r.readstring('RegisteredOwner');  
Organization.Caption:=r.readstring('RegisteredOrganization');  
r.Free; //надо уничтожить этот объект, так как он нам больше не нужен  

Таким образом весь этот обработчик должен иметь примерно такой вид:


procedure TLogo.FormCreate(Sender: TObject);  
var R:Tregistry;  
begin  
R:=TRegistry.Create;  
R.RootKey:=HKEY_LOCAL_MACHINE;  
R.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion', False);  
UserName.Caption:=r.readstring('RegisteredOwner');  
Organization.Caption:=r.readstring('RegisteredOrganization');  
r.Free;  
end;  

Ну вот собственно и все что я хотел вам рассказать о заставках. Теперь ваши программы будут выглядеть более солидно. Но помните, что при создании небольших, вспомогательных программ, объем которых не превышает килобайт 100-150 заставки лучше не использовать.

Удачи в программировании...

Автор: Михаил Христосенко

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

События, происходящие в приложениях Delphi при завершении работы Windows

Я провел небольшое исследование, и вот что я выяснил:

При закрытии приложения (используя системное меню или вызывая метод закрытия формы), возникают следующие события:

FormCloseQuery - действие по умолчанию, устанавливает переменную CanClose в значание TRUE и продолжает закрытие формы.
FormClose
FormDestroy
Если приложение активно и вы пытаетесь завершить работу Windows (Shut Down), происходят следующие события (с соблюдением последовательности):

FormCloseQuery
FormDestroy
Мы видим, что метод FormClose в этом случае не вызывается.

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

Windows посылает сообщение WM_QUERYENDSESSION всем приложениям и ожидает ответ.
Каждое приложение получает сообщение и возвращает одну из величин: не равную нулю - приложение готово завершить свою работу, 0 - приложение не может завершить свою работу.
Если одно из приложений возвращает 0, Windows не завершает свою работу, а снова рассылает всем окнам сообщение, на этот раз WM_ENDSESSION.
Каждое приложение должно снова подтвердить свою готовность завершить работу, поэтому операционная система ожидает ответа TRUE, резонно предполагая, что оставшиеся приложения с момента предыдущего сообщения закрыли свои сессии и готовы завершить работу. Теперь посмотрим, как на это реагирует Delphi-приложение: приложение возвращает значение TRUE и немедленно вызывает метод FormDestroy, игнорируя при этом метод FormClose. Налицо проблема.
Завершение работы Windows.
Первое решение проблемы: приложение Delphi на сообщение WM_QUERYENDSESSION должно возвратить 0, не дав при этом Windows завершить свою работу. При этом бессмысленно пытаться воспользоваться методом FormCloseQuery, поскольку нет возможности определить виновника завершения работы приложения (это может являться как результатом сообщения WM_QUERYENDSESSION, так и просто действием пользователя при попытке закрыть приложение).

Другое решение состоит в том, чтобы при получении сообщения WM_QUERYENDSESSION самим выполнить необходимые действия, вызвав метод FormClose.

Пример:


unit Unit1;  
interface  
uses  
   
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,  
  
Dialogs;  
type  
   
TForm1 = class(TForm)  
procedure FormClose(Sender: TObject; var Action: TCloseAction);  
private  
{--------------------------------------------------------}  
{ Объявляем свой обработчик сообщения WM_QUERYENDSESSION }  
{--------------------------------------------------------}  
procedure WMQueryEndSession(  
var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;  
public  
{ Public declarations }  
end;  
  
var  
   
Form1    : TForm1;  
  
  
implementation  
{$R *.DFM}  
  
{--------------------------------------------------------------}  
{ Создаем процедуру обработки сообщения WM_QUERYENDSESSION.    }  
{ Приложение получит только это сообщение при попытке Windows  }  
{ завершить работу                                             }  
{--------------------------------------------------------------}  
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);  
begin  
   
inherited;   { сначала сообщание должен обработать наследуемый метод }  
{--------------------------------------------------------------------}  
{ в этой точке вы также можете сообщить Windows о неготовности       }  
{ приложения завершить работу...                                     }  
{ Message.Result:=0;                                                 }  
{-------------------------------------------или----------------------}  
{ вызов процедуры освобождения ресурсов, предусмотренной в FormClose }  
{ MyCleanUpProcedure;                                                }  
{--------------------------------------------------------------------}  
  
end;  
  
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
   
MyCleanUpProcedure;  
  
end;  
  
end.  

Я не тестировал этот код, но могу предположить, что он должен работать. Сообщите, если это не так!

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

Создать динамический массив

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

Этот динамический массив основан на массиве Delphi. Поэтому обращение к нему быстро и удобно. Тип TArray – это массив нужного типа. 128 элементов можно заменить любым другим числом, хоть 0. Повлиять это может только на отладку программы, так как Delphi выведет (если уместится) именно это количество элементов. PArray – это указатель на TArray. При обращении к элементам массива для Delphi главное, чтобы этот элемент существовал в памяти, то есть, чтобы под него была выделена память. А проверять, находится ли номер нужного элемента между 0 и 127 Delphi не будет.

Главным методом объекта является SetCount. Он сделан таким образом, что при изменении количество элементом старые данные не теряются, а новые элементы всегда обнуляются.

Процедура Reset обнуляет все существующие элементы.

Для того чтобы сделать этот массив, например, массивом целых чисел нужно поменять все double на integer или еще что-то.

Если Ваша программа часто обращается к элементам массива, то имеет смысл создать переменную типа PArray и присвоить ей адрес данных (поле p динамического массива), а дальше обращаться к ней, как к самому обыкновенному массиву. Только не забудьте обновлять эту переменную при изменении количества элементов.


type  
  TForm1 = ...  
    ...  
  end;  
  
  TArray = array [0..127] of double;  
  PArray = ^TArray;  
  TDynArray = object  
    p: PArray;  
    count: integer;  
    constructor Create(ACount: integer); { инициализация }  
    procedure SetCount(ACount: integer); { установка количества 
                                           элементов }  
    procedure Reset; { обнуление данных }  
    destructor Destroy; { уничтожение }  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
constructor TDynArray.Create(aCount: integer);  
begin  
  p := nil;  
  count := 0;  
  SetCount(ACount);  
end;  
  
procedure TDynArray.SetCount(ACount: integer);  
var  
  np: PArray;  
begin  
  if count = ACount then Exit;  
  if p = nil then begin { память не была выделена }  
    if ACount <= 0 then begin { новое количество элементов 
                                в массиве равно 0 }  
      count := 0;  
    end else begin  { новое количество элементов в массиве 
                      больше 0 }  
      GetMem(p, ACount * sizeof(double)); { выделение памяти }  
      fillchar(p^, ACount * sizeof(double), 0); { обнуление данных }  
      count := ACount;  
    end;  
  end else begin  
    if ACount <= 0 then begin { новое количество элементов в 
                                массиве равно 0 }  
      FreeMem(p, count * sizeof(double)); { освобождение памяти }  
      count := 0;  
    end else begin  
      GetMem(np, ACount * sizeof(double)); { выделение памяти }  
      if ACount > count then begin { требуется увеличить 
                                     количество элементов }  
        move(p^, np^, count * sizeof(double)); { перемещение 
                                старых данных на новое место }  
        fillchar(np^[count], (ACount - count) * sizeof(double),  
          0); { обнуление новых элементов массива }  
      end else begin  
        move(p^, np^, ACount * sizeof(double)); { перемещение  
                           части старых данных на новое место }  
      end;  
      FreeMem(p, count * sizeof(double)); { освобождение старой 
                                            памяти }  
      p := np;  
      count := ACount;  
    end;  
  end;  
end;  
  
procedure TDynArray.Reset;  
begin  
  fillchar(p^, count * sizeof(double), 0); { обнуление данных }  
end;  
  
destructor TDynArray.Destroy;  
begin  
  SetCount(0);  
end;  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  a: TDynArray;  
  i: integer;  
  s: string;  
begin  
  a.Create(3);  
  a.p[0] := 10;  
  a.p[1] := 20;  
  { второй элемент не указывается, но вследствие обнуления 
    при создании массива он равен 0 }  
  s := 'Элементы в массиве:';  
  for i := 0 to a.count - 1 do  
    s := s + #13#10 + IntToStr(i+1) + ': ' + FloatToStr(a.p[i]);  
  ShowMessage(s);  
  
  a.SetCount(4);  
  a.p^[3] := 50;  
  { значения первых элементов не теряются }  
  s := 'Элементы в массиве:';  
  for i := 0 to a.count - 1 do  
    s := s + #13#10 + IntToStr(i+1) + ': ' + FloatToStr(a.p[i]);  
  ShowMessage(s);  
  
  a.Destroy;  
end;  

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

Пример авторизации на сайте с помощью idHTTP.Post

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

Сегодня расскажу, как использовать idHTTP.Post для авторизации на сайте. Я возьму для примера сайт LiveJournal.com.

Немного теории для начинающих. Итак, вызов метода Post компонента idHTTP отличается от вызова Get-а только тем, что помимо URL-а необходимо передать параметры. Параметры можно передавать в виде StringList-а, или каких-нибудь Stream-ов, или чего-нибудь еще подходящего.)

Пример Post-процедуры (параметры передаются в виде StringList-а):


procedure TForm1.Button1Click(Sender: TObject);  
var  
  LoginInfo: TStringList;  
  Response: TStringStream;  
begin  
  try  
    LoginInfo := TStringList.Create;  
    Response := TStringStream.Create('');  
    LoginInfo.Add('username=MyName');  
    LoginInfo.Add('password=MyPass');  
    IdHTTP1.Post('http://mywebsite.xxx/login.php',LoginInfo,Response);  
    Showmessage(Response.DataString);  
  finally  
    begin  
      Response.Free;  
      LoginInfo.Free;  
    end;  
  end;  
end;  

Пример Post-функции (параметры передаются в виде IdMultiPartFormDataStream-а):


uses IdMultipartFormData;  
{ .... }  
  
procedure TForm1.Button1Click(Sender: TObject);  
var  
  data: TIdMultiPartFormDataStream;  
begin  
  data := TIdMultiPartFormDataStream.Create;  
  try  
    // добавляем нужные параметры  
    data.AddFormField('param1', 'value1');  
    data.AddFormField('param2', 'value2');  
    // для примера выводим в мемо все, что вернулось  
    Memo1.Lines.Text := IdHTTP1.Post('http://localhost/script.php', data);  
  finally  
    data.Free;  
  end;  
end;  

Сейчас попробуем применить полученные знания. Идем на LiveJournal.com, включаем сниффер, логинимся на сайте и смотрим, какие параметры надо передавать ('mode=login', 'user=логин', 'password=пароль'). Авторизация не произойдет, если на стороне клиента не будут сохранены кукисы. Для сохранения кукисов среди компонентов Indy существует TidCookieManager. IdCookieManager подключается к idHTTP через свойство CookieManager.


idHttp.CookieManager := IdCookieManager;  

В этом случае при запросах в заголовок добавляются кукисы, автоматически сохраненные в IdCookieManager. IdCookieManager можно найти на закладке Indy Misc или создать динамически.



Поместим на форму 2 TEdit-а, TMemo и кнопку, на которую повесим следующий работающий код авторизации:


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Http  : TidHttp;  
  CM    : TidCookieManager;  
  Data  : TStringList;  
  StrPage, UserID,  UserName  :  String;  
  i : integer;  
begin  
  try  
    Http := TIdHTTP.Create(Self);  
    Data := TStringList.Create;  
    CM := TidCookieManager.Create(Http);  
    Http.AllowCookies := true;  
    Http.CookieManager := CM;  
    Http.HandleRedirects := true;  
  
    Http.Request.Host:='livejournal.com';  
    Http.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';  
    Http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';  
    Http.Request.AcceptLanguage:='ru,en-us;q=0.7,en;q=0.3';  
    Http.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';  
    Http.Request.Referer:='http://www.livejournal.com/';  
  
    Data.Add('mode=login');  
    Data.Add('user=' + Edit1.Text);  
    Data.Add('password=' + Edit2.Text);  
    StrPage := Http.Post('http://www.livejournal.com/login.bml?ret=1', Data);  
  finally  
    Data.Free;  
    CM.Free;  
    Http.Free;  
  end;  
  
  if Pos('<input class="logoutlj_hidden" id="user" name="user" type="hidden" value="'+Edit1.Text,StrPage) <> 0 then  
    ShowMessage('Авторизация прошла успешно')  
  else  
    ShowMessage('Авторизация провалилась');  
  
  Memo1.Lines.Text := StrPage;  
end;  

Возвращенные заголовки (после ответа сервера) можно посмотреть так:


idHttp.Response.RawHeaders.GetText;  

Сохраненные в CookieManager-е кукисы можно посмотреть так:


for i := 0 to Http.CookieManager.CookieCollection.Count - 1 do  
  StrPage := StrPage + CM.CookieCollection.Items[i].CookieText + #13#10;  

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

Работа с динамическими массивами в Delphi

Что такое динамический массив? Динамический массив есть контейнер, содержащий определенное число данных, которые могут быть записаны либо извлечены для каких-нибудь с ними действий. Проще говоря, это лимитированный список различных значений одной переменной (Integer, String и т.д.), каждый из которых можно затребовать простым указанием порядкового номера. Зачем он нужен? как с ним работать? — читайте далее и всё поймете.

Прежде всего, надо продекларировать наш массив (то бишь записать его название). Название массива имеет такой вид:


<Имя_Массива>: Array[<область_определения>] of <Тип_переменных>
Идентификаторы Array и of постоянны, так что их нужно указывать в любом случае. Имя массива зависит только от вашей фантазии. Область определения имеет вид [X..Y], где первая величина — наименьшее значение числа определяемых параметров, вторая — наибольшее. Заметьте, данное свойство указывается именно в квадратных скобках — собственно значения X и Y входят в область определения массива. Повторю, что эти значения определяют именно порядковые номера хранящихся в массиве значений и предназначены для их чтения («вытаскивания» из массива) посредством указания порядкового номера. X и Y могут быть только простыми числами. Так же они могут быть частями какого-либо упорядоченного целого: например, можно указать [‘а’..’я’], и массив будет состоять из тридцати трех значений (по числу букв алфавита).

Далее после идентификатора of указывается тип переменных, в котором хранятся данные в массиве. Если это Boolean, то всякий параметр может иметь значение только True или False. Если Integer — то этот же параметр является простым числом, и т.д.

Сейчас мы по всем правилам продекларируем какой-нибудь массив:


EditArray: Array[1..5] of String  

Наметанным глазом можно прочитать здесь следующее: имеется массив с именем EditArray, в котором хранится пять различных значений типа String (текст). Кажется, всё правильно :). Но этот массив пуст: в нем нет еще никаких данных. Сейчас мы используем его, чтобы запомнить строковую информацию, содержащуюся в TEdit’ах и, когда нужно, достать ее.

Выложите на форму пять компонентов TEdit и две кнопки. Назовите их GetBtn и ResultBtn. Чтобы можно было отличать строки ввода друг от друга, измените им в редакторе свойств параметр Tag: у Edit1 на «1», у Edit2 на «2» и так далее вплоть до «5» у Edit5.


//...  
var  
Form1: TForm1;  
EditArray: Array[1..5] of String;  
//...  
  
//записываем информацию в массив  
procedure TForm1.GetBtnClick(Sender: TObject);  
var  
i: integer;  
begin  
//перебираем все компоненты   
for i:=0 to ComponentCount-1 do  
if Components[i] is TEdit then  
EditArray[TEdit(Components[i]).Tag]:=TEdit(Components[i]).Text;  
end;  
   
//читаем информацию из массива  
procedure TForm1.SetBtnClick(Sender: TObject);  
var  
i: integer;  
begin  
for i:=0 to ComponentCount-1 do  
if Components[i] is TEdit then  
TEdit(Components[i]).Text:=EditArray[TEdit(Components[i]).Tag];  
end;  

Теперь введите в Edit’ы какой-нибудь текст и нажмите GetBtn. Сотрите текст и нажмите ResultBtn.

Ага! Вот мы и поработали с декларированным массивом. Но надо иметь ввиду, что есть и константированные массивы с изначально записанными значениями, которые нельзя изменить. Такие массивы прописываются в разделе const. Они полезны, когда нужно выполнить множество низкоуровневых операций.

В одном из последних выпусков журнала «Хакерспец» вебмастерам предлагался весьма простой способ обозначить копирайт текстов своего сайта: менять некоторые русские буквы на латинские, которые выглядят точно так же. (Чтобы, буде информацию все-таки умыкнут, можно было воспользоваться этим отличием для подтверждения авторских прав). Вот моя реализация данного совета с помощью констатированного массива. Осчастливьте вашу форму компонентами TRichEdit и TButton, по событию OnClick последнего поставьте следующий код:


procedure TForm1.Button1Click(Sender: TObject);  
const  
RusSymbols: Array[1..10] of ShortString = ('а','с','о','р','х','А','С','О','Р','Х');  
EngSymbols: Array[1..10] of ShortString = ('a','c','o','p','x','A','C','O','P','X');  
var  
i, position: integer;  
Text: String;  
begin  
Text:=RichEdit1.Lines.Text;  
repeat  
//Массив состоит из десяти символов,   
//поэтому цикл повторится 10 раз.  
for i:=1 to 10 do begin  
position:=pos(RusSymbols[i],Text);  
if position>0 then begin  
delete(Text,position,1);  
insert(EngSymbols[i],Text,position);  
end;  
end;  
until position<=0;  
RichEdit1.Lines.Text:=Text;  
end;  

Закодируйте таким образом какой-нибудь текст и проверьте правописание полученного в MS Word.

Теперь вы знаете простейшие примеры работы с динамическими массивами.

Автор: Трофим Роцкий

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

Фрактальные множества Delphi

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

Здесь хочу остановиться на фрактальных множествах Мандельброта и Жюлиа. Изображения этих множеств не имеют каких либо четко очерченных границ. Особенностью фракталов является то, что даже маленькая часть изображения в конечном итоге представлет общее целое, особенно хорошо этот эффект можно пронаблюдать на примере множества Жюлиа. Кстати на основе этого свойства фракталов основано фрактальное сжатие данных, но эту тему разберем как-нибудь позже (когда накопиться достаточно нужного материала).

Итак приступим к самому главному, ради чего мы здесь и собрались. Как же строятся эти удивителные множества ?

Все сводится к вычислению одной единственной формулы.


Zi+1=Zi2+C   

Здесь Z и C - комплексные числа. Как видно, формулы по сути представляет собой обычную рекурсию (или что-то вроде многократно примененного преобразования). Зная правила работы с комплексными числами данную формулу можно упростить и привести к следующему виду.


xi+1=xi2-yi2+a  
yi+1=2*xi*yi+b  

Построение множества Мандельброта сводится к следующему. Для каждой точки (a,b) проводится серия вычислений по вышеприведенным формулам, причем x0 и y0 принимаются равными нулю, т.е. точка в формуле выступает в качестве константы. На каждом шаге вычиляется величина r=sqrt(x2+y2 ). Значением r ,как ни трудно заметить, является расстояние точки с координатами (x,y) от начала координат ( r=sqrt[ (x-0)2+(y-0)2] ). Исходная точка (a,b) считается принадлежащей множеству Мандельброта, если она никогда не удаляется от начала координат на какое-то критическое число. Для отображения можно подсчитать скорость удаления от центра, если например точка ушла за критическое расстояние, и в зависимости от нее окрасить исходную точку в соответствующие цвет. Полное изображение множества Мандельброта можно получить на плоскости от -2 до 1 по оси x и от -1.5 до 1.5 по оси y. Также известно, что для получения примелимой точности достаточно 100 итеарций (по теории их должно быть бесконечно много). Ниже представлен листинг функции реализующей выполнение итераций и определение принадлежности точки множеству Мандельброта, точнее на выходе мы получаем цвет для соответствующе точки. В качестве критического числа взято число 2. Чтобы не вычислять корень, мы сравниваем квадрат расстояния (r2) с квадратом критического числа, т.е. сравниваем (x2+y2) и 4.


function MandelBrot(a,b: real): TColor;  
var  
    x,y,xy: real;  
    x2,y2: real;  
    r:real;  
    k: integer;  
begin  
    r:=0;  
    x:=0; y:=0;  
    k:=100;  
    while (k>0)and(r<4) do  
    begin  
        x2:=x*x;  
        y2:=y*y;  
        xy:=x*y;  
        x:=x2-y2+a;  
        y:=2*xy+b;  
        r:=x2+y2;  
        dec(k)  
    end;  
    k:=round((k/100)*255);  
    result:=RGB(k,k,k);  
end;   

Множество Жюлиа получается если зафиксировать в формуле значение комплексной константы (a+ib), которая будет одинакова для всех точек, а начальные значения x0 и y0 принимать равными значениям координатам вычисляемой точки. Листинг для множества Жюлиа приведен ниже.


function Julia(x0,y0: real): TColor;  
var  
    a,b,x,y,x2,y2,xy: real;  
    r:real;  
    speed,k: integer;  
begin  
    r:=1;  
    a:=-0.55; b:=-0.55;  
    x:=x0; y:=y0;  
    k:=100;  
    while (k>0)and(r<4) do  
    begin  
        x2:=x*x;  
        y2:=y*y;  
        xy:=x*y;  
        x:=x2-y2+a;  
        y:=2*xy+b;  
        r:=x2+y2;  
        dec(k)  
    end;  
    k:=round((k/100)*255);  
    result:=RGB(k,k,k);  
end;   

Ниже приведен листинг функции отображающий данные множества.


procedure TForm1.BitBtn2Click(Sender: TObject);  
var  
    x_min,y_min,x_max,y_max,hx,hy,x,y: real;  
    i,j,n: integer;  
    color: TColor;  
begin  
    x_min:=-1.5; x_max:=2;  
    y_min:=-1.5; y_max:=1.5;  
    n:=300;  
    y:=y_min;  
    hx:=(x_max-x_min)/n;  
    hy:=(y_max-y_min)/n;  
    for j:=0 to n do  
    begin  
        x:=x_min;  
        for i:=0 to n do  
        begin  
            if rbM.Checked then color:=MandelBrot(x,y);  
            if rbJ.Checked then color:=Julia(x,y);  
            imPict.Picture.Bitmap.Canvas.Pixels[i,j]:=color;  
            x:=x+hx;  
        end;  
        y:=y+hy;  
    end;  
end;   

При рассмотрении темы большую помощь оказала статья А.Колесникова "Визуализация фрактальных структур" в "Компьтерных вестях".

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

ШИФРОВАНИЕ В DELPHI

Данные надо беречь. Сам посуди, обидно, если открытие ценой в сто миллионов енотов или рецепт безалкогольной водки, над которым ты корпел три вечера в мрачном подвале нелегального компьютерного клуба, — уплывет к злостному ленивому конкуренту, который, пользуясь твоим похмельем, наложил грязную лапу на приватные дискеты с ценнейшей инфой?! Дальше можно не продолжать. Шифруем, шифруем, шифруем!..

Добрый дядюшка Borland предоставил нам несколько занятных функций для работы со строками, о которых не все знают. Сосредоточены они в модуле StrUtils.pas. Такие функции, как RightStr, LeftStr совмещают стандартные команды Copy и Delete: так, LeftStr возвращает значение левой части строки до указанной вами позиции (что вытворяет RightStr, догадайся сам), а функция ReverseString и вовсе делает зеркальное отображение данной строки: 321 вместо 123. Используем ее в особенности, чтобы осложнить жизнь хитрому дешифровщику.
Алгоритм шифрования будет прост, как Win 3.1. С каждым символом кодируемого документа проделаем следующее:

Преобразуем символ в число командой Ord.
Преобразуем каждый символ пользовательского пароля в число и сумму этих чисел прибавим к полученному в пункте 1.
От результата отнимаем число, равное позиции данного символа. То есть буковки будут шифроваться по-разному в зависимости от их позиции в строке :).
То, что получилось, запишем обратно из чисел в символы командой Chr. Как видишь, после всех наших манипуляций этот символ уже будет другим.
Запишем всю строку навыворот командой ReverseString.
Дешифровка, как ты догадываешься, будет производиться в обратном порядке.
Теперь, когда алгоритм намертво засел в голове, реализуем соответствующую программу. Внимание! Не исключено, что это будет первая твоя программа с настоящим синтаксисом команд:
<команда> <путь> <пароль>
— так будет выглядеть он в консоли нашего приложения (да, оно будет консольным!). Команд всего две: crypt и decrypt — соответственно зашифровать и дешифровать файл, путь к которому указывается после пробела, а затем — твой пароль. НЕ ЗАБУДЬ ЕГО! Предупреждаю совершенно серьезно. Запомнил? В бой!

Crypt C:\file.txt linuxmustsurvive

— закодируем File.txt. Результат (зашифрованный текст) сохраниться в той же директории, что и исполняемый файл нашего приложения под именем Translated_File.txt.

Decrypt C:\Translated_file.txt linuxmustsurvive

— дешифровка.
Реализовывается это вот как:


program Crypter;  
  
{$APPTYPE CONSOLE}  
  
uses  
SysUtils,  
StrUtils; //!!  
  
var  
F, //входящий файл  
F1: TextFile; //результат (файл с переводом)  
ToDo, FileName, PassW, Line, TranslatedFile: string;  
position, IsCrypt: integer;  
  
//находим сумму числовых значений символов пароля  
function Password(Psw: string): integer;  
var  
i,res: integer;  
begin  
res:=0;  
for i:=1 to Length(psw) do res:=res+ord(psw[i]);  
result:=res;  
end;  
  
function Crypt(CryptStr: string): string;  
var  
s: string;  
i: integer;  
begin  
if CryptStr<>EmptyStr then  
for i:=1 to Length(CryptStr) do begin  
s:=LeftStr(CryptStr,1);  
CryptStr:=RightStr(CryptStr,Length(CryptStr)-1);  
//ШИФРОВКА:  
s:=chr(ord(s[1])+Password(PassW)-i);  
result:=result+s;  
end;  
result:=ReverseString(result);  
end;  
  
function Decrypt(DecryptStr: String): String;  
var  
i: integer;  
s: String;  
begin  
DecryptStr:=ReverseString(DecryptStr);  
if DecryptStr<>EmptyStr then  
for i:=1 to Length(DeCryptStr) do begin  
s:=LeftStr(DeCryptStr,1);  
DeCryptStr:=RightStr(DeCryptStr,Length(DeCryptStr)-1);  
//ДЕШИФРОВКА:  
result:=result+chr(ord(s[1])-password(PassW)+i);  
end;  
end;  
  
begin  
while true do begin  
isCrypt:=0;  
writeln(#10+'Crypter >'+#10);  
//Какую команду ввел юзер?  
readln(ToDo);  
if UpperCase(ToDo)='EXIT' then Exit;  
if AnsiContainsText(ToDo,'decrypt') then isCrypt:=1  
else if AnsiContainsText(ToDo,'crypt') then isCrypt:=2;  
//прочитав команду, удаляем ее из строки и читаем дальше  
position:=pos(' ',ToDo);  
if position>0 then ToDo:=RightStr(ToDo,Length(ToDo)-position);  
//Читаем путь к файлу  
position:=pos(' ',ToDo);  
if position>0 then FileName:=LeftStr(ToDo,position-1);  
//Читаем пароль  
PassW:=RightStr(ToDo,Length(ToDo)-position);  
//Всё правильно? Начинаем!  
if (isCrypt<=0) or (PassW=EmptyStr) or (not FileExists(FileName)) then writeln('Wrong command')  
else begin  
TranslatedFile:=ExtractFilePath(paramStr(0)) + 'translated_' + ExtractFileName(FileName);  
//соединяемся с файлами  
AssignFile(F, FileName);  
AssignFile(F1, TranslatedFile);  
//переходим в начало файла  
Rewrite(F1);  
Reset(F);  
//читаем строки, пока не дойдем до конца файла  
while not EOF(F) do begin  
//читаем из переводимого файла  
ReadLn(F, Line);  
if isCrypt=1 then Line:=Decrypt(Line);  
if isCrypt=2 then Line:=Crypt(Line);  
//записываем в файл с переводом  
Writeln(F1, Line);  
end;  
//отсоединямся от файлов  
CloseFile(F);  
CloseFile(F1);  
end;  
end;  
end.  

Вот, собственно, и всё. Еще раз напоминаю, что результат (файл с переводом) сохранится В ТОЙ ЖЕ ДИРЕКТОРИИ, что и наше приложение, а не в той, где лежит исходный файл. В заключение процитирую отрывок из статьи «Криптография в C++» в номере 3.03 журнала «Хакер»:

//(с) Николай «GorluM» Андреев
Но я хочу тебя предупредить: в нашей стране, согласно указу № 334 от 1995 года, производить и распространять любые шифрующие средства можно, только имея лицензию ФАПСИ. Соответственно, шифровать нельзя :). Поэтому пиши программы только для личного пользования и только в познавательных целях.

Автор: Трофим Роцкий

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

Работа с форматом M3U

Интро.

Поводом для написания этой статьи послужило то, что я в Интернете не нашёл ни одной подобной статьи, описывающей такой формат. Начнём с назначения m3u файлов. Не для кого, думаю, не секрет, что этот тип файлов используется в WinAmp 'е для (со)хранения «плей листа». В этой статье мы рассмотрим запись и чтение m3u файлов.

Ближе к делу. Теория.

Формат этого файла таков: в начале файла есть служебное слово [#EXTM3U], означающее, что выбранный нами файл действительно m3u. Далее идут строки вида:

#EXTINF:120,Вася барабанщик – Kill My
My Music\Kill_My.mp3


Где [#EXTINF:] служебное слово, [120] – длина трека в секундах, [Вася барабанщик – Kill My ] – тэг, а [ My Music\Kill_My.mp3] – путь к файлу. Причём путь к файлу не полный и зависит от места расположения m3u файла. Пример: m3u файл находится в папке X:\ Music, а муз. файлы в X:\Music\My Music\Kill_My.mp3, тогда путь к файлу в плей листе будет My Music\Kill_My.mp3. А если файл музыки и файл плей листа будут на разных дисках, то путь будет полным. К чему такие сложности я не знаю, ведь можно просто писать полный путь и никаких проблем не будет. И ещё, если переместить файл плей листа, то WinAmp (и др. программы) не смогут воспроизвести файл, так как не найдут путь к нему. (При условии, что путь неполный).

Ближе к делу. Практика.

Казалось бы неполный путь к файлу создаёт нам дополнительные проблемы. Это так. Но я написал функцию, которая восстанавливает этот путь. Итак, рассмотрим на примере, как можно загрузить в ListView данные из m3u файла. На форму помещаем ListView с тремя колонками. 1-я колонка – тэг, 2-я – длина трека, 3-я – путь. И добавим OpenDialog, для открытия файла, и кнопочку.


function NotFullPathToFullPath(FM3U, FM: string): string;  
(*Из неполного пути -> полный*)  
var  
  Ress: string;  
begin  
  Ress := '';  
  Result := '';  
(*Если 1-й символ ‘\’, то просто добавляем букву диска*)  
  if FM[1] = '\' then  
  begin  
    Result := ExtractFileDrive(FM3U) + FM;  
    exit;  
  end else  
  begin  
(*Путь к m3u + неполный путь к файлу*)  
    if FileExists(ExtractFilePath(FM3U) + FM) then  
    begin  
      Result := ExtractFilePath(FM3U) + FM;  
      exit;  
    end;  
(*А вдруг путь уже полный?*)  
    if FileExists(FM) then  
    begin  
      Result := FM;  
      exit;  
    end;  
  end;  
end;  
  
procedure ReadM3U(files: string);  
(*Чтение m3u*)  
(*Думаю всё и так понятно без комментариев ;)*)  
var List: TStringList;  
  i, n: integer;  
  s, a: string;  
  ListItem: TListItem;  
begin  
(*Очищаем ЛистВив*)  
  Form1.ListView1.Clear;  
  List := TStringList.Create;  
  try  
    List.LoadFromFile(files);  
    for i := 0 to List.Count - 1 do  
    begin  
(*Первая строка – «#EXTM3U»? Если да, то это файл m3u*)  
      if List.Strings[0] = '#EXTM3U' then  
      begin  
        s := List.Strings[i];  
        if s[1] <> '#' then  
        begin  
          ListItem.SubItems.Add('');  
          s := NotFullPathToFullPath(Files, s);  
          ListItem.SubItems[1] := s;  
        end else  
        begin  
          if s <> '#EXTM3U' then  
          begin  
            Delete(S, 1, 8);  
            a := '';  
            n := 1;  
            repeat  
              a := a + s[n];  
              Inc(n);  
            until s[n] = ',';  
            Delete(S, 1, Length(a) + 1);  
            ListItem := Form1.ListView1.Items.Add;  
            ListItem.Caption := s;  
            ListItem.SubItems.Add(Format('%d:%.2d', [StrToInt(a) div 60, StrToInt(a) mod 60]));  
          end;  
        end;  
      end;  
    end;  
  finally  
    List.Free;  
  end;  
end;  

А вызывать будем по кнопке:


procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if OpenDialog1.Execute then  
    ReadM3U(OpenDialog1.FileName) else exit;  
end;  

Так. Открытие мы сделали. Можете открыть свой плей лист, сохраненный в WinAmp'е и вглянуть на то, что получилось. Перейдём к сохранению. Положите на форму ещё одну кнопку и в путь. Не забудьте подключить модуль StrUtils.


function ExtNotFullPath(FM3U, FM: string): string;  
(*Из полного пути в неполный*)  
var  
  i: integer;  
  Ress: string;  
begin  
  Ress := '';  
  Result := '';  
  for i := 1 to Length(FM3U) do  
  begin  
    if FM3U[i] = FM[i] then  
    begin  
      Ress := Ress + FM3U[i];  
      if FM3U[i] = '\' then Result := Ress;  
    end else exit;  
  end;  
end;  
  
function MinToSec(tim: string): string;  
(*Это такой компьютерный юмор, функция из минут в секунды, результат String ;)*)  
(*Помнишь мы секунды преобразовывали в минуты? Вот теперь всё наоборот*)  
var n: integer;  
  a: string;  
begin  
  n := 1;  
  a := '';  
  repeat  
    a := a + tim[n];  
    Inc(n);  
  until tim[n] = ':';  
  Delete(tim, 1, Length(a) + 1);  
  result := IntToStr((StrToInt(a) * 60) + StrToInt(tim));  
end;  
  
procedure SaveList(SaveFile: string);  
(*Сохранение...*)  
var List: TStringList;  
  i: integer;  
  b, s: string;  
begin  
  List := TStringList.Create;  
  List.Add('#EXTM3U');  
  for i := 0 to Form1.ListView1.Items.Count - 1 do  
  begin  
    s := '';  
    List.Add('#EXTINF:' + MinToSec(Form1.ListView1.Items.Item[i].SubItems.Strings[0]) + ',' + Form1.ListView1.Items.Item[i].Caption);  
    b := ExtNotFullPath(SaveFile, Form1.ListView1.Items.Item[i].SubItems.Strings[1]);  
    if Length(b) < Length(ExtractFilePath(SaveFile)) then  
    begin  
      s := Form1.ListView1.Items.Item[i].SubItems.Strings[1];  
      if b<>`` then //проверка, на одинаковых ли дисках?  
        Delete(s, 1, 2);  
    end else  
      s := AnsiReplaceText(Form1.ListView1.Items.Item[i].SubItems.Strings[1], b, '');  
    List.Add(s);  
  end;  
(*Сохраняем в файл*)  
  List.SaveToFile(SaveFile);  
  List.Free;  
end;  

А вот и кнопочка пригодилась :-)


procedure TForm1.Button2Click(Sender: TObject);  
begin  
  if SaveDialog1.Execute then  
  begin  
    if ExtractFileExt(SaveDialog1.FileName) = '.m3u' then  
      SaveList(SaveDialog1.FileName) else SaveList(SaveDialog1.FileName + '.m3u');  
  end;  
end;  

The End.

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

Работа с массивами в Delphi

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

Ввод массива
Для того чтобы работать с массивом, его надо с начала получить от пользователя. Попробуем осуществить ввод одномерного массива всего в одно поле редактирования. Каждый элемент массива будет отделяться от предыдущего разделителем. После щелчка на кнопке программа выделит из строки, содержащей массив, первую подстроку, затем выделит вторую подстроку и т.д.

Давайте сейчас этим и займемся. Поставьте на Вашу форму кнопку Button и пооле редактирования Edit.

Заголовок нашей функции будет такой:


function GetSubStr(st:string; expl:string; n:integer):string;  

где

st - строка, содержащая массив
expl - строка разделитель
n - номер подстроки


function TForm1.GetSubStr(st:string; expl:string ;n:integer):string;  
Var p,i:integer;  
Begin  
for i:= 1 to n-1 do  
begin  
p:=pos(expl,st);  
st:=copy(st,p+1,Length(st)-p);  
while (pos(expl,st)=1) and (length(st)>0) do  
delete(st,1,1);  
end;  
p:=pos(expl,st);  
if p<>0 then result:=copy(st,1,p-1)  
else result:=st;  
End;  

Для получения n-ой подстроки (элемента массива) из полученной в качестве аргумента строки функция сначала удаляет предшествующую ей n-1 подстроку (цикл for), затем находит разделитель, который обозначает конец нужной подстроки, выделяет подстроку и возвращает ее в качестве значения функции (через свое имя).

Не забудьте добавить заголовок нашей функции в раздел Public модуля программы.

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


procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;  
a:array[1..10] of string[10];  
st:string;  
begin  
for i:=1 to 10 do  
a[i]:=GetSubStr(Edit1.text,' ',i);//используем пробел в качестве разделителя  
  
for i:=1 to 10 do  
st:=st+IntTostr(i)+' '+a[i]+#13;  
ShowMessage(st);  
end;  

Поиск минимального (максимального) элемента массива
Будем искать минимальный элемент в целочисленном массиве. Для этого немного изменим обработчик события OnClick для кнопки:


procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;//номер элемента, сравниваемого с минимальным  
a:array[1..10] of integer;   
min:integer;//номер минимального элемента  
  
begin  
//Введем массив  
for i:=1 to 10 do  
//Преобразуем полученные подстроки в числа  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
//Найдем минимальный элемент  
min:=1; //пусть номер минимального элемента = 1  
for i:= 2 to 10 do // начнем искать со следующего   
if a[i] < a[min] then min:=i;  
Form1.caption:=IntToStr(a[min]); // выводим в заголовок формы минимальный элемент  
end;  

В этом примере a
 минимальный элемент массива, а min - номер минимального элемента. Алгоритм очень простой: сравниваем каждый следующий элемент с минимальным, если он меньше минимального, то запоминаем его номер в переменной min, и продолжаем сравнивать уже с ним. 

Чтобы найти максимальный элемент, нужно изменить всего одну строку:


[DELPHI]>>> if a[i] < a[min] then min:=i;  

Надо заменить на:


if a[i] > a[min] then min:=i;  

Только теперь a
 - максимальный элемент, а min  - номер максимального элемента.

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

Элемент, совпадение с которым нам надо найти будем хранить в текстовом поле Edit2. Обработчик события OnClick нашей кнопки будет иметь такой вид:


[DELPHI]procedure TForm1.Button1Click(Sender: TObject);  
var i:integer;  
a:array[1..10] of integer;  
n:integer;//образец  
found:boolean;  
  
begin  
//Введем массив  
for i:=1 to 10 do  
//Преобразуем полученные подстроки в числа  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
  
  
n:=StrToInt(Edit2.text);  
found:=false;  
i:=1;  
REPEAT  
if a[i] = n then found:=true  
else i:=i+1;  
UNTIL (i > 10) or (found = true);  
if found then showmessage('Совпадение с элементом номер '+IntToStr(i));  
end;  

Сортировка массива
Вот мы и дошли до самого интересного - до сортировки массива. Рассмотрим алгоритм т.н. прямого выбора. Смысл его заключается в следующем:

Просматривая массив от первого элемента, найдем минимальный элемент и поместим его на место первого элемента, а первый элемент - на место минимального.

Затем будем просматривать массив, начиная со второго элемента, и далее поступим, как поступили перед этим шагом.

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


procedure TForm1.Button1Click(Sender: TObject);  
var i,k,j,min:integer;  
buf:integer; // буфер для обмена  
a:array[1..10] of integer;  
st:string;  
begin  
//введем массив  
for i:=1 to 10 do  
a[i]:=StrToInt(GetSubStr(Edit1.text,' ',i));//используем пробел в качестве разделителя  
  
for i:=1 to 10 - 1 do // кол-во элементов минус один  
begin  
//поищем минимальный элемент  
min:=i;  
for j:=i+1 to 10 do  
if a[j] < a[min] then min:=j;  
//поменяем местами  
buf:=a[i];  
a[i]:=a[min];  
a[min]:=buf;  
end;  
  
for k:=1 to 10 do  
Form1.Caption:=Form1.caption + ' '+ IntToStr(a[k]);  
end;  

Ну вот мы и познакомились с самыми типичными действиями с массивами. Надеюсь эта статья оказалась Вам хоть немного полезной :)

Автор: Михаил Христосенко

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