Забавное программирование в Delphi

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

Итак, поехали...

Автоматически нажимающаяся кнопка
Этот компонент представляет из себя кнопку, на которую не надо нажимать, чтобы получить событие OnClick. Достаточно переместить курсор мышки на кнопку. При создании такого компонента традиционным способом, требуется довольно много времени, так как необходимо обрабатывать мышку, перехватывать её и т.д. Однако результат стоит того!

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


type  
  TAutoButton1 = class(TButton)  
  private  
    procedure WmMouseMove (var Msg: TMessage);  
      message wm_MouseMove;  
  end;  
  
procedure TAutoButton1.WmMouseMove (var Msg: TMessage);  
begin  
  inherited;  
  if Assigned (OnClick) then  
    OnClick (self);  
end;  

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


type  
  TAutoKind = (akTime, akMovement, akBoth);  
  
  TAutoButton2 = class(TButton)  
  private  
    FAutoKind: TAutoKind;  
    FMovements: Integer;  
    FSeconds: Integer;  
    // really private  
    CurrMov: Integer;  
    Capture: Boolean;  
    MyTimer: TTimer;  
    procedure EndCapture;  
    // обработчики сообщений  
    procedure WmMouseMove (var Msg: TWMMouse);  
      message wm_MouseMove;  
    procedure TimerProc (Sender: TObject);  
    procedure WmLBUttonDown (var Msg: TMessage);  
      message wm_LBUttonDown;  
    procedure WmLButtonUp (var Msg: TMessage);  
      message wm_LButtonUp;  
  public  
    constructor Create (AOwner: TComponent); override;  
  published  
    property AutoKind: TAutoKind  
      read FAutoKind write FAutoKind default akTime;  
    property Movements: Integer  
      read FMovements write FMovements default 5;  
    property Seconds: Integer  
      read FSeconds write FSeconds default 10;  
  end;  

Итак, когда курсор мышки попадает в область кнопки (WmMouseMove), то компонент запускает таймер либо счётчик количества сообщений о перемещении. По истечении определённого времени либо при получении нужного количества сообщений о перемещении, компонент эмулирует событие нажатия кнопкой.


procedure TAutoButton2.WmMouseMove (var Msg: TWMMouse);  
begin  
  inherited;  
  if not Capture then  
  begin  
    SetCapture (Handle);  
    Capture := True;  
    CurrMov := 0;  
    if FAutoKind <> akMovement then  
    begin  
      MyTimer := TTimer.Create (Parent);  
      if FSeconds <> 0 then  
        MyTimer.Interval := 3000  
      else  
        MyTimer.Interval := FSeconds * 1000;  
      MyTimer.OnTimer := TimerProc;  
      MyTimer.Enabled := True;  
    end;  
  end  
  else // захватываем  
  begin  
    if (Msg.XPos > 0) and (Msg.XPos < Width)  
      and (Msg.YPos > 0) and (Msg.YPos < Height) then  
    begin  
      // если мы подсчитываем кол-во движений...  
      if FAutoKind <> akTime then  
      begin  
        Inc (CurrMov);  
        if CurrMov >= FMovements then  
        begin  
          if Assigned (OnClick) then  
            OnClick (self);  
          EndCapture;  
        end;  
      end;  
    end  
    else // за пределами... стоп!  
      EndCapture;  
  end;  
end;  
  
procedure TAutoButton2.EndCapture;  
begin  
  Capture := False;  
  ReleaseCapture;  
  if Assigned (MyTimer) then  
  begin  
    MyTimer.Enabled := False;  
    MyTimer.Free;  
    MyTimer := nil;  
  end;  
end;  
  
procedure TAutoButton2.TimerProc (Sender: TObject);  
begin  
  if Assigned (OnClick) then  
    OnClick (self);  
  EndCapture;  
end;  
  
procedure TAutoButton2.WmLBUttonDown (var Msg: TMessage);  
begin  
  if not Capture then  
    inherited;  
end;  
  
procedure TAutoButton2.WmLButtonUp (var Msg: TMessage);  
begin  
  if not Capture then  
    inherited;  
end;  

Как осуществить ввод текста в компоненте Label ?
Многие программисты задавая такой вопрос получают на него стандартный ответ "используй edit box." На самом же деле этот вопрос вполне решаем, хотя лейблы и не основаны на окне и, соответственно не могут получать фокус ввода и, соответственно не могут получать символы, вводимые с клавиатуры. Давайте рассмотрим шаги, которые были предприняты мной для разработки данного компонента.

Первый шаг, это кнопка, которая может отображать вводимый текст:


type  
  TInputButton = class(TButton)  
  private  
    procedure WmChar (var Msg: TWMChar);  
      message wm_Char;  
  end;  
  
procedure TInputButton.WmChar (var Msg: TWMChar);  
var  
  Temp: String;  
begin  
  if Char (Msg.CharCode) = #8 then  
  begin  
    Temp := Caption;  
    Delete (Temp, Length (Temp), 1);  
    Caption := Temp;  
  end  
  else  
    Caption := Caption + Char (Msg.CharCode);  
end;  

С меткой (label) дела обстоят немного сложнее, так как прийдётся создать некоторые ухищрения, чтобы обойти её внутреннюю структуру. Впринципе, проблему можно решить созданием других скрытых компонент (кстати, тот же edit box). Итак, посмотрим на объявление класса:


type  
  TInputLabel = class (TLabel)  
  private  
    MyEdit: TEdit;  
    procedure WMLButtonDown (var Msg: TMessage);  
      message wm_LButtonDown;  
  protected  
    procedure EditChange (Sender: TObject);  
    procedure EditExit (Sender: TObject);  
  public  
    constructor Create (AOwner: TComponent); override;  
  end;  

Когда метка (label) создана, то она в свою очередь создаёт edit box и устанавливает несколько обработчиков событий для него. Фактически, если пользователь кликает по метке, то фокус перемещается на (невидимый) edit box, и мы используем его события для обновления метки. Обратите внимание на ту часть кода, которая подражает фокусу для метки (рисует прямоугольничек), основанная на API функции DrawFocusRect:


constructor TInputLabel.Create (AOwner: TComponent);  
begin  
  inherited Create (AOwner);  
  
  MyEdit := TEdit.Create (AOwner);  
  MyEdit.Parent := AOwner as TForm;  
  MyEdit.Width := 0;  
  MyEdit.Height := 0;  
  MyEdit.TabStop := False;  
  MyEdit.OnChange := EditChange;  
  MyEdit.OnExit := EditExit;  
end;  
  
procedure TInputLabel.WMLButtonDown (var Msg: TMessage);  
begin  
  MyEdit.SetFocus;  
  MyEdit.Text := Caption;  
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);  
end;  
  
procedure TInputLabel.EditChange (Sender: TObject);  
begin  
  Caption := MyEdit.Text;  
  Invalidate;  
  Update;  
  (Owner as TForm).Canvas.DrawFocusRect (BoundsRect);  
end;  
  
procedure TInputLabel.EditExit (Sender: TObject);  
begin  
  (Owner as TForm).Invalidate;  
end;  

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

Компонент звуковой кнопки имеет два новых свойства:


type  
  TDdhSoundButton = class(TButton)  
  private  
    FSoundUp, FSoundDown: string;  
  protected  
    procedure MouseDown(Button: TMouseButton;  
      Shift: TShiftState; X, Y: Integer); override;  
    procedure MouseUp(Button: TMouseButton;  
      Shift: TShiftState; X, Y: Integer); override;  
  published  
    property SoundUp: string  
      read FSoundUp write FSoundUp;  
    property SoundDown: string  
      read FSoundDown write FSoundDown;  
  end;  

Звуки будут проигрываться при нажатии и отпускании кнопки:


procedure TDdhSoundButton.MouseDown(  
  Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
begin  
  inherited;  
  PlaySound (PChar (FSoundDown), 0, snd_Async);  
end;  
  
procedure TDdhSoundButton.MouseUp(Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
begin  
  inherited;  
  PlaySound (PChar (FSoundUp), 0, snd_Async);  
end;  

Экранный вирус
Никогда не видели экранного вируса? Представьте, что Ваш экран заболел и покрылся красными пятнами :) А если эта болезнь нападёт на какое-нибудь окно ? Всё, что нам надо, это получить контекст устройства при помощи API функции GetWindowDC и рисовать, что душе угодно.

К исходному коду особых комментариев не требуется, скажу лишь только то, что основная часть кода находится в обработчике события OnTimer:


type  
  TScreenVirus = class(TComponent)  
  private  
    FTimer: TTimer;  
    FInterval: Cardinal;  
    FColor: TColor;  
    FRadius: Integer;  
  protected  
    procedure OnTimer (Sender: TObject);  
    procedure SetInterval (Value: Cardinal);  
  public  
    constructor Create (AOwner: TComponent); override;  
    procedure StartInfection;  
  published  
    property Interval: Cardinal  
      read FInterval write SetInterval;  
    property Color: TColor  
      read FColor write FColor default clRed;  
    property Radius: Integer  
      read FRadius write FRadius default 10;  
  end;  
  
constructor TScreenVirus.Create (AOwner: TComponent);  
begin  
  inherited Create (AOwner);  
  FTimer := TTimer.Create (Owner);  
  FInterval := FTimer.Interval;  
  FTimer.Enabled := False;  
  FTimer.OnTimer := OnTimer;  
  FColor := clRed;  
  FRadius := 10;  
end;  
  
procedure TScreenVirus.StartInfection;  
begin  
  if Assigned (FTimer) then  
    FTimer.Enabled := True;  
end;  
  
procedure TScreenVirus.SetInterval (Value: Cardinal);  
begin  
  if Value <> FInterval then  
  begin  
    FInterval := Value;  
    FTimer.Interval := Interval;  
  end;  
end;  
  
procedure TScreenVirus.OnTimer (Sender: TObject);  
var  
  hdcDesk: THandle;  
  Brush: TBrush;  
  X, Y: Integer;  
begin  
  hdcDesk := GetWindowDC (GetDesktopWindow);  
  Brush := TBrush.Create;  
  Brush.Color := FColor;  
  SelectObject (hdcDesk, Brush.Handle);  
  X := Random (Screen.Width);  
  Y := Random (Screen.Height);  
  Ellipse (hdcDesk, X - FRadius, Y - FRadius,  
    X + FRadius, Y + FRadius);  
  ReleaseDC (hdcDesk, GetDesktopWindow);  
  Brush.Free;  
end;  

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

В приведённом ниже примере при помощи обычного диалогового окна пользователю показывается сообщение об ошибке, причём кнопка "close" накак не хочет нажиматься. У этого диалога есть зависимое окно, которое показывается, при нажатии кнопки "details".

Поддельная форма с сообщением об ошибке имеет кнопку "details", которая открывает вторую часть формы. Это достигается путём добавления компонента за пределы самой формы:


object Form2: TForm2  
  AutoScroll = False  
  Caption = 'Error'  
  ClientHeight = 93  
  ClientWidth = 320  
  OnShow = FormShow  
  object Label1: TLabel  
    Left = 56  
    Top = 16  
    Width = 172  
    Height = 65  
    AutoSize = False  
    Caption =   
      'Программа выполнила недопустимую ' +  
      'операцию. Если проблема повторится, ' +  
      'то обратитесь к разработчику программного обеспечения.'  
    WordWrap = True  
  end  
  object Image1: TImage  
    Left = 8  
    Top = 16  
    Width = 41  
    Height = 41  
    Picture.Data = {...}  
  end  
  object Button1: TButton  
    Left = 240  
    Top = 16  
    Width = 75  
    Height = 25  
    Caption = 'Close'  
    TabOrder = 0  
    OnClick = Button1Click  
  end  
  object Button2: TButton  
    Left = 240  
    Top = 56  
    Width = 75  
    Height = 25  
    Caption = 'Details >>'  
    TabOrder = 1  
    OnClick = Button2Click  
  end  
  object Memo1: TMemo // за пределами формы!  
    Left = 24  
    Top = 104  
    Width = 265  
    Height = 89  
    Color = clBtnFace  
    Lines.Strings = (  
      'AX:BX    73A5:495B'  
      'SX:PK    676F:FFFF'  
      'OH:OH   7645:2347'  
      'Crash    3485:9874'  
      ''  
      'What'#39's going on here?')  
    TabOrder = 2  
  end  
end  

Когда пользователь нажимает кнопку "details", то программа просто изменяет размер формы:


procedure TForm2.Button2Click(Sender: TObject);  
begin  
  Height := 231;  
end;  

Вторая форма, которая наследуется от первой имеет перемещающуюся кнопку "close":


procedure TForm3.Button1Click(Sender: TObject);  
begin  
  Button1.Left := Random (ClientWidth - Button1.Width);  
  Button1.Top := Random (ClientHeight - Button1.Height);  
end;  

В заключении, можно сделать дырку в окне, используя API функцию SetWindowRgn:


procedure TForm1.Button4Click(Sender: TObject);  
var  
  HRegion1, Hreg2, Hreg3: THandle;  
  Col: TColor;  
begin  
  ShowMessage ('Ready for a real crash?');  
  Col := Color;  
  Color := clRed;  
  PlaySound ('boom.wav', 0, snd_sync);  
  HRegion1 := CreatePolygonRgn (Pts,  
    sizeof (Pts) div 8,  
    alternate);  
  SetWindowRgn (  
    Handle, HRegion1, True);  
  ShowMessage ('Now, what have you done?');  
  Color := Col;  
  ShowMessage ('Вам лучше купить новый монитор');  
end;  

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

Еще пара способов получения содержимого страницы

Ранее я описывала самый простой способ получения html-кода страницы. Перед тем, как перейти к созданию прототипа парсера ключевых слов, рассмотрим еще пару способов. При использовании этих способов страница не отображается в контейнере.

Компонент TIdHTTP
Идем на вкладку Indy Clients и из широчайшего выбора компонентов останавливаемся на TIdHTTP. Компонент TIdHTTP (Indy клиент HTTP) используется для поддержки сетевого протокола HTTP на стороне клиента (поддерживаются версии 1.0 и 1.1, включая операции GET, POST и HEAD). Кроме того, обеспечивается поддержка аутентификации пользователей и применение прокси-серверов. Можете самостоятельно поэкспериментировать с ним. Я же покажу самое простое. Киньте на новую форму этот компонент, мемо и кнопку. В обработчике клика кнопки напишите:


 try   
  s := IdHTTP1.Get('http://yandex.ru');   
  Memo1.Text := s;   
except   
end;   

Всего одна строчка кода — и в переменной s у вас окажется всё, что вернет Get-запрос. Мы получили все, что нужно для дальнейшей обработки.

UrlDownloadToFile
В uses добавляем UrlMon. Объявляем функцию:


function DownloadFile(SourceFile, DestFile: string): Boolean;  

Реализация:


function DownloadFile(SourceFile, DestFile: string): Boolean;   
begin   
  try   
    Result := UrlDownloadToFile(nil, PChar(SourceFile),   
PChar(DestFile), 0,   
         nil) = 0;   
  except   
       Result := False;   
  end;   
end;  

Пример использования:


try   
  SLBody:=TStringList.Create;   
  sFileName:=ExtractFilePath(Application.ExeName) + 'cache.txt';   
  currBody:='';   if DownloadFile(LinkStr,sFileName) then   
     SLBody.LoadFromFile(sFileName);   
  currBody:=SLBody.Text;   
  DeleteFile(sFileName);   
finally   
  SLBody.Free;   
end;  

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

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

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

Для начинающих работать с компонентом IdHTTP в Delphi

Найти компонент idHTTP можно на вкладке Indy Clients.

После того, как поместите его на форму, посмотрите его параметры и свойства в Object Inspector- е. Вы увидите, что работать с протоколом HTTP с помощью этого компонента достаточно просто. Для "составления" правильных заголовков запросов к серверу будем плотно работать с TIdHTTP.Request. Многие поля вам уже знакомы. Там же есть возможность привязки к объекту idHTTP компонента для удобной работы с кукисами (компонент idCookieManager) и настройка работы через прокси.

Рассмотрим способы отправки запросов Get и Post. С такими названиями существуют и функции, и процедуры. Непосредственно перед отправкой запроса следует настроить свойства вышеупомянутого IdHTTP.Request-а, если есть необходимость. Например, UserAgent в idHTTP по умолчанию Mozilla/3.0 (compatible; Indy Library), и, чтобы не палиться, следует его заменить на что-нибудь более безобидное :) А если вы создаете экземпляры компонента idHTTP динамически для парсинга страниц какого-нибудь большого сайта, то юзерагента можно вообще брать Рандомом из заранее подготовленного списка.

Пример использования процедуры idHTTP.Get без дополнительных настроек:


var   
  mStream: TMemoryStream;   
   
mStream := TMemoryStream.Create;   
try   idHttp := TIdHTTP.Create(nil);   
  {  тут  следует  "настроить " параметры  idHTTP }   
  { ... }   
  try   
    idHttp.Get(URL, mStream);   
  finally   
    idHttp.Free;   
  end;   
finally   
  mStream.Free;   
end;  

Или с помощью функции получить содержимое страницы в строковую переменную:


Str := idHttp.Get(URL); 

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

Какие еще аспекты работы с idHTTP следует отметить?
После посылки запроса проверить ответ сервера можно, посмотрев содержимое свойства


idHTTP.Response.ResponseText   

Стандартым ответом о том , что все прошло удачно , является HTTP/1.0 200 OK.

Бывают и другие ответы сервера (про коды ответов я упоминала в одной из предыдущих записей). Остановлю внимание только на двух наиболее часто встречающихся группах:
2хх: Успешно. Сигнал был успешно принят, понят и принят к обработке.
Зхх: Перемаршрутизация . Необходимо предпринять определенные действия , чтобы выполнить запрос.

Исключения, возникающие при работе компонентов Indy (тип EIdH TTPProtocolException),
классифицируются особым образом.


Except   
on E:EIdHTTPProtocolException do   
ShowMessage(E.ErrorMessage);  

Классификация исключений может пригодиться . У меня был случай , когда написанный парсер работал без проблем , но спустя какое -то время отказался работать . Помог анализ ответа сервера : на сайте временно поставили перенаправление (Код 302 Found:
HTTP_FOUND — Запрошенный ресурс был временно перемещен на новый URI), возможность которого я в начальной версии не предусмотрела. С тех пор во всех своих парсерах я проверяю код ответа: не 302 ли случаем? (Если код ответа 301 (Moved Permanently:
HTTP MOVED PERMANENTLY — Запрошенный документ был перенесен на новый URI), то информация берется без проблем, если у idHTTP свойство HandleRedirects := true, а вот с 302 это не прокатывает. Так же отдельно я обрабатываю код 404). Еще у компонента надо грамотно настроить все таймауты, чтобы, если обнаружится исключительная ситуация, запрос не "подвисал".

Пример кода для обработки исключений разного типа:


procedure TForm1.Button1Click(Sender: TObject);   
begin   
 Memo1.Lines.Clear;   
 try   
   Memo1.Lines.Add(IdHTTP1.Get(Edit1. Text));   
 except on e : EIDHttpProtocolExcepti on do   
   Begin      if e.ErrorCode = 302 then   
       begin   
         try   
           // получаем новый адрес - адрес перенаправления   
           Memo1.lines.add(idhttp1.Ge t(IdHTTP1.Response.Locati on));   
         except on e:Exception do   
    // предусматриваем, что исключение  может возникнуть и тут    
           ShowMessage(' Ошибка  при  получении  нового  адреса .'+e.Message);   
         end;   
       end   
     else   
       //http 404, 501  и так  далее    
       ShowMessage(' Ошибка  другого  вида , не  302:'+e.Message);   
   end;   
 on e:Exception do   
   ShowMessage('Ошибка: ' + e.Message);    
 end;   
end;  

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

Динамическое создание компонентов

Сегодня поговорим о том, как создавать компоненты во время работы программы.

Иногда заранее не известно количество компонентов. Поэтому в Delphi есть возможность создать их из программы. Для этого достаточно вызвать конструктор Create, установить нужные свойства и события. А для появления компонента на экран нужно установить свойство Parent.

При нажатии на левую кнопку мыши эта программа создает Button, а при нажатии на правую - Panel. Причем компоненты создаются там, где находится мышь. Если Вы нажали на Panel1, то компонент появится на Panel1.


...  
  public  
    procedure OnButtonClick(Sender: TObject);  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.DFM}  
  
uses stdctrls, extctrls;  
  
procedure TForm1.OnButtonClick(Sender: TObject);  
begin  
  if Sender is TButton then  
    with (Sender as TButton) do  
      Caption := Caption + '1';  
end;  
  
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
var  
  b: TButton;  
  p: TPanel;  
begin  
  if Button = mbRight then begin  
    p := TPanel.Create(nil);  
    p.Caption := 'Panel' + IntToStr(random(100));  
    p.Left := X;  
    p.Top := Y;  
    p.Width := random(200) + 100;  
    p.Height := random(200) + 100;  
    p.OnMouseDown := Form1.OnMouseDown;  
    p.Parent := Sender as TWinControl;  
  end else begin  
    b := TButton.Create(nil);  
    b.Caption := 'Button' + IntToStr(random(100));  
    b.ShowHint := true;  
    b.Hint := 'Hint for ' + b.Caption;  
    b.Left := X;  
    b.Top := Y;  
    b.OnClick := OnButtonClick;  
    b.Parent := Sender as TWinControl;  
  end;  
end;  

Но может понадобиться что-то делать с компонентами после их создания. В этом случае нужно создать массив, в котором будут лежать эти компоненты. Эта программа хранит в массиве 100 кнопок. При изменении размера окна кнопки перегруппируются.


var  
  b: array [0..99] of TButton;  
  
procedure TForm1.FormCreate(Sender: TObject);  
var  
  i: integer;  
  c: integer;  
begin  
  c := Form1.ClientWidth div 52;  
  for i := low(b) to high(b) do begin  
    b[i] := TButton.Create(nil);  
    b[i].Caption := IntToStr(i + 1);  
    b[i].Width := 50;  
    b[i].Height := 20;  
    b[i].Left := 52 * (i mod c);  
    b[i].Top := 22 * (i div c);  
    b[i].Parent := Form1;  
  end;  
end;  
  
procedure TForm1.FormResize(Sender: TObject);  
var  
  i: integer;  
  c: integer;  
begin  
  c := Form1.ClientWidth div 52;  
  for i := low(b) to high(b) do begin  
    b[i].Left := 52 * (i mod c);  
    b[i].Top := 22 * (i div c);  
  end;  
end;  

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

Динамические массивы

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

Цель это примера научить тебя работать с динамическими массивами, ты будешь встречаться с ними постоянно, поэтому я решил уделить этому внимание уже сейчас. Рассмотрим первую процедуру:


var  
 r:array of integer;  
 i:Integer;  
begin  
 ListBox1.Items.Clear;  
 SetLength(r,10);  
  
 for i:=0 to High(r) do  
  begin  
   r[i]:=i*i;  
   ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i]));  
  end;  

Эта процедура вызывается по нажатии первой кнопки. В области объявлений VAR я объявил две переменные. Первая это r которая является массивом чисел типа Integer. Вторая i это переменная, которую я буду использовать в качестве счётчика. Переходим к самой процедуре:

Первая строка очищает все строки у ListBox1. Для этого вызывается процедура ListBox1.Items.Clear. Объясню подробней. У ListBox1 есть свойство Items, где хранятся все строки. У Items есть метод Clear, который удаляет все находящиеся в нём строки.

Во второй строке вызывается процедура SetLength, которая выделила память для массива r (первый параметр), размером в 10 элементов (второй параметр). Обращение к элементом будет происходить как r[номер_элемента]. Элементы будут нумероваться от 0 до 9. Вообще, в программировании всё нумеруется с нуля.

Далее используется конструкция:


for выражение1 to выражение2 do  
  begin  
  end;  

Эта конструкция создаёт цикл выполняя операторы между Begin и End, "Выражение2" - "Выражение1" количество раз. Функция High(r) возвращает количество элементов в массиве r. В итоге получается, что цикл будет выполняться от i:=0 (от нуля), до количества элементов в массиве r (до 9). Внутри массива выполняется две строки:

r:=i*i . Здесь i-му элементу массива присваивается i*i. ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i])); Эта строка добавляет новый элемент в ListBox1. Функция IntToStr переводит число в строку. С первой процедурой мы разобрались, теперь перейдём ко второй: [DELPHI]type TDynArr=array of integer; var r:TDynArr; i:Integer; begin ListBox1.Items.Clear; SetLength(r,10); for i:=0 to High(r) do r[i]:=i*i; SetLength(r,20); for i:=10 to High(r) do r[i]:=i*i; for i:=0 to High(r) do ListBox1.Items.Add(IntToStr(i)+' в квадрате ='+IntToStr(r[i]));
Эта процедура выполняет похожие действия, но с небольшими особенностями. В начале я объявляю новый тип: TDynArr=array of integer . После этого конструкция r:TDynArr; будет означать, что r относится к типу TDynArr, а тот относится к array of integer; . Это тоже самое, что мы писали в первой процедуре r:array of integer; , только такая конструкция удобней, если ты захочешь объявить несколько динамических массивов. Тебе не приходится сто раз писать громоздкую строку r:array of integer; , ты объявляешь новый массив как TDynArr.

Далее идёт всё та же очистка строк и выделение памяти под массив.


for i:=0 to High(r) do  
  r[i]:=i*i;  

Эта конструкция заполняет десять элементов квадратами числа i. После этого я снова вызываю функцию SetLength(r,20);, в которой говорю, что массив теперь будет состоять из 20-и элементов. Таким способом можно как увеличивать количество элементов, так и уменьшать.


for i:=10 to High(r) do  
  r[i]:=i*i;  

Здесь я заполняю квадратами числа i элементы начиная с 10 по последний. И в конце я снова заполняю ListBox1 значениями элементов массива.

Теперь о том, как я изменил иконку для программы. Для того, чтобы изменить иконку для формы нужно дважды щёлкнуть в Object Inspector по свойству Icon и выбрать любую.

Для изменения иконки программы нужно щёлкнуть по меню Project и выбрать пункт Option . В появившемся окне выбрать закладку Application и на этой странице нажать кнопку Load Icon .

На сегодня новостей больше нет.

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

Делаем многострочный Caption у Button

Не раз сталкивался с такой проблемой когда необходимо что бы caption у button был многострочным т.е если подпись не влезает в размеры кнопки она располагалась не в одну строку а в несколько.

Как это сделать мы и разберем в данном уроке.

Ну что погнали, открываем delphi создаем новый проект, сейчас нужно сразу оговориться что делать многострочными мы будем все кнопки, которые находиться на панели. И сразу же кидаем на форму компонент Panel с закладки Standart, на неё ставим 2 компонента button так же с закладки Standart. Далее выберите Первую кнопку и в свойстве Caption напишите побольше текста, тоже самое проделываем и со второй кнопкой.

А вот теперь и начинается самое интересное.

Переходим в код и после ключевого слова private пишем


procedure SetMultiLineButton(AParent: TWinControl) ;   

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


procedure TForm1.SetMultiLineButton(AParent: TWinControl);  
var j : integer;  
ah : THandle;  
begin  
for j := 0 to AParent.ControlCount - 1 do  
if (AParent.Controls[j] is TButton) then  
begin  
ah := (AParent.Controls[j] as TButton).Handle;  
SetWindowLong(ah, GWL_STYLE,  
GetWindowLong(ah, GWL_STYLE) OR  
BS_MULTILINE) ;  
end;  
end;  

Вот практически и все осталось создать обработчик событий OnCreate на форме и в нем прописать


SetMultiLineButton (Panel1); 

Вот теперь все, запускаем проект, вуаляяяя.... текст на кнопках располагается в несколько строк.

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

Выбор лотка принтера для печати

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

Первым делом в раздел uses добавляем модуль Printers, затем после ключевого слова public прописываем вот такую строчку


procedure ChangePrinterTray;  

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


procedure TForm1.ChangePrinterTray;  
var  
ADevice, ADriver, APort: array [0..255] of Char;  
ADeviceMode: THandle;  
DevMode: PDeviceMode;  
begin  
Printer.GetPrinter( ADevice, ADriver, APort, ADeviceMode );  
if ADeviceMode <> 0 then  
begin  
GlobalUnlock( ADeviceMode );  
DevMode := GlobalLock( ADeviceMode ); //Получаем указатель на текущие параметры  
DevMode.dmDefaultSource := DMBIN_AUTO; //Здесь указывается параметры относительно лотка (в данный момент указывается, что выбирается автоматически)  
DevMode.dmFields := DevMode.dmFields or DM_DEFAULTSOURCE; //Указывает, что мы будем обновлять  
GlobalUnlock( ADeviceMode );  
Printer.SetPrinter( ADevice, ADriver, APort, ADeviceMode );//Применяем новые параметры  
end;  
end;   

На этом все,... ДА чуть не забыл помимо автоматического выбора лотка существуют следующие параметры:


DMBIN_ONLYONE  
DMBIN_MIDDLE  
DMBIN_LOWER  
DMBIN_MANUAL  
DMBIN_ENVELOPE  
DMBIN_ENVMANUAL  
DMBIN_AUTO  
DMBIN_TRACTOR  
DMBIN_SMALLFMT  
DMBIN_LARGEFMT  
DMBIN_LARGECAPACITY  
DMBIN_CASSETTE  
DMBIN_FORMSOURCE  

Вот сейчас действиельно все !!!

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

Вставляем Progress в ListView

Всем HI, в этом уроке мы научимся вставлять в компонент ListView компонент ProgressBar. Открываем delphi, кидаем на форму компонент ListView, 2 компонента button и компонент Timer. Для начала нам нужно создать 2 столбца в компоненте ListView, выделяем его, находим свойство columns и жмем по нему. Появиться небольшое окошечко, в котором нужно два раза нажать на кнопку с изображением желтой папки (Add New). Как вы наверно уже поняли, только что мы создали 2 колонки в компоненте ListView, но они пока еще не отображаються, что бы это исправить находим свойство ViewStyle и выставляем в нем значение на vsReport. Все на этом предварительные настроки завершены. Начинаем кодить.

Выделяем первую кнопку, при нажатии на неё пользователь будет добавлять строки (содержащие в себе компонент ProgressBar) в компонент ListView. Итак, создаем обработчик событий OnClick на первой кнопке. Полный код обработчика событий приведен ниже, посмотрите на него и допишите к себе недостающие строки.


procedure TForm1.Button1Click(Sender: TObject);  
const  
pbColumnIndex = 1;  
pbMax = 100;  
var  
li : TListItem;  
lv : TListView;  
pb : TProgressBar;  
pbRect : TRect;  
begin  
lv := ListView1;  
li := lv.Items.Add;  
li.Caption := 'Item ' + IntToStr(lv.Items.Count);  
pb := TProgressBar.Create(nil);  
pb.Parent := lv;  
li.Data := pb;  
pbRect := li.DisplayRect(drBounds);  
pbRect.Left := pbRect.Left +  
lv.Columns[-1 + pbColumnIndex].Width;  
pbRect.Right := pbRect.Left +  
lv.Columns[pbColumnIndex].Width;  
pb.BoundsRect := pbRect;  
end;  

Так добавлять строки в компонент ListView мы научились, осталось научиться их удалять. Для этого нам и понадобиться вторая кнопка. Выделяем её и создаем на ней обработчик событий OnClick. Опять же полный код обработчика приведен ниже, посмотрите на него и добавьте к себе недостающие строки.


procedure TForm1.Button2Click(Sender: TObject);  
var  
lv : TListView;  
li : TListItem;  
i, idx : integer;  
pb : TProgressBar;  
begin  
lv := ListView1;  
li := lv.Selected;  
if li <> nil then  
begin  
idx := li.Index;  
TProgressBar(li.Data).Free;  
lv.Items.Delete(idx);  
for i := idx to -1 + lv.Items.Count do  
begin  
li := lv.Items.Item[i];  
pb := TProgressBar(li.Data);  
pb.Top := pb.Top -  
(pb.BoundsRect.Bottom -  
pb.BoundsRect.Top);  
end;  
end;  
end;  

Сейчас я хочу немного оживить компонент ProgressBar и сделать так что бы Progress увеличивался. Вот тут то нам на помощь приходит компонент Timer, выделяем его и создаем на нем обработчик событий Ontime. Полный код обработчика представлен ниже:


procedure TForm1.Timer1Timer(Sender: TObject);  
var  
idx : integer;  
pb: TProgressbar;  
lv : TListView;  
begin  
lv := ListView1;  
if lv.Items.Count = 0 then Exit;  
idx := Random(lv.Items.Count);  
pb := TProgressBar(lv.Items[idx].Data);  
if pb.Position < pb.Max then  
pb.StepIt  
else  
pb.Position := 0;  
end;  

Да и не забудьте свойство Enabled у компонента Timer выставить в значение true

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

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

Вставка Bitmap через буфер обмена


function CopyClipToBuf(DC: HDC; Left, Top,  
           Width, Height: Integer;  Rop: LongInt;  
           var CopyDC: HDC;  
           var CopyBitmap: HBitmap): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  CopyDC := 0;  
  CopyBitmap := 0;  
  if DC <> 0 then  
    begin  
      CopyDC := CreateCompatibleDC(DC);  
      if CopyDC <> 0 then  
        begin  
          CopyBitmap := CreateCompatibleBitmap(DC,  
                          Width, Height);  
          if CopyBitmap <> 0 then  
            begin  
              TempBitmap := CopyBitmap;  
              CopyBitmap := SelectObject(CopyDC,  
                              CopyBitmap);  
              Result := BitBlt(CopyDC, 0, 0,  
                          Width, Height, DC,  
                          Left, Top, Rop);  
              CopyBitmap := TempBitmap;  
            end;  
        end;  
    end;  
end;  
  
function CopyBufToClip(DC: HDC; var CopyDC: HDC;  
           var CopyBitmap: HBitmap;   
           Left, Top, Width, Height: Integer;  
           Rop: LongInt; DeleteObjects: Boolean): Boolean;  
var  
  TempBitmap: HBitmap;  
begin  
  Result := False;  
  if (DC <> 0) and  
     (CopyDC <> 0) and  
     (CopyBitmap <> 0) then  
    begin  
      TempBitmap := CopyBitmap;  
      CopyBitmap := SelectObject(DC, CopyBitmap);  
      Result := BitBlt(DC, Left, Top,  
                  Width, Height, CopyDC,  
                  0, 0, Rop);  
      CopyBitmap := TempBitmap;  
      if DeleteObjects then  
        begin  
          DeleteDC(CopyDC);  
          DeleteObject(CopyBitmap);  
        end;  
    end;  
end;  

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

Внешняя компонента. Аналог ОтправитьДляОбработки() объекта HTTPReader v7plus.dll (1С 7.7)

В программе «1С:Предприятие» версии 7.7 для работы с Интернет предусмотрен объект HTTPReader компоненты v7plus.dll. В частности, для получения WEB-станицы с сервера предусмотрен метод ОтправитьДляОбработки(). Пример использования указанного метода можно найти здесь. Как видно из примера функционал данного метода может очень сильно помочь при решении интеграционных задач. И не было б никакого смысла в написании данной статьи, если б не одно НО. У метода ОтправитьДляОбработки() ест один весьма существенный недостаток: в случае, если сервер в заголовке ответа не передает размер пакета, то принимаемая страница обрезается до размера в примерно 1024 байта (приблизительно логику данного явления можно понять при дальнейшем ознакомлении с этой статьей). Именно указанное неудобство побудило автора сначала к написанию внешней компоненты, а впоследствии и этой статьи.
Для реализации задачи средством разработки было принято Delphi 6 как единственная среда разработки кроме 1С, которой автор владеет на необходимом уровне. Скажу сразу, что писать компоненты для 1С «с нуля» дело весьма хлопотное и неблагодарное. По этой причине был использован шаблон, взятый отсюда. Я не стану подробно останавливаться на принципах разработки внешних компонент для 1С (это весьма хорошо описано в последней ссылке) а сразу перейду к делу.

Итак, для получения данных по HTTP используем следующие методы (не забыв подключить библиотеку wininet).


InternetOpen  
InternetOpenUrl  
HttpQueryInfo  
InternetReadFile  
InternetQueryDataAvailable  
InternetReadFile  
InternetQueryDataAvailable  
InternetCloseHandle  

О назначении и применении указанных методов можно прочесть здесь.

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

var url: string;  
        hSession, hfile: hInternet;  
        dwindex,dwcodelen :dword;  
        dwcode:array[1..20] of char;  
        res : pchar;  
        fSize, ReadLen:DWORD; //<-количество реально прочитанных байт  
        fBuf:array[1..1024]of byte;//<-буфер куда качаем  
        f:file; //<-файл куда качаем  
        s,i_f: string;  
        flag:integer;  
  begin  
    case mode of  
      m_rus_name: Result:='ПолучитьВебСтраницу';//Имя процедуры  
      m_eng_name: Result:='GetWWWPage';//Англоязычный синоним  
      m_n_params: g_NParams:=3; //Количество параметров функции  
      m_execute: begin  
        flag:=GetParamAsInteger(0);//тип действия 1-записать в файл, 2-записать в переменную  
        url:=GetParamAsString(1);//адрес  
        i_f:=GetParamAsString(2);//имя файла  
        fSize:=0; //<- |переменных  
        if pos('http://',lowercase(url))=0 then  
        url := 'http://'+url;  
        hSession := InternetOpen('InetURL:/1.0',//открываем адрес  
        INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);  
        if assigned(hsession) then  
        begin  
        hfile := InternetOpenUrl(hsession, pchar(url), nil,  0,  INTERNET_FLAG_RELOAD, 0);  
        dwIndex  := 0;  
        dwCodeLen := 10;  
        HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);  
        res := pchar(@dwcode);  
        if (res ='200') or (res ='302') then  
        result:= '1'  
        else result:= '0';  
        //Попробуем получить страницу...  
        if result='1' then  
        begin  
                if flag=1 then begin  
                AssignFile(f,i_f);//открываем файл  
                ReWrite(f,1);  
                while ReadLen<>0 do  
                begin  
                //читаем в буфер  
                InternetReadFile(hfile, @fBuf, SizeOf(fBuf), ReadLen);  
                //смотрим ск-ко осталось докачать  
                InternetQueryDataAvailable(hfile, fSize,0,0);  
                BlockWrite(f, fBuf, ReadLen) //<-пишем в файл  
                end;  
                end  
                else  
                begin  
                result:='';  
                while ReadLen<>0 do  
                begin  
                //читаем в буфер  
                        InternetReadFile(hfile, @fBuf, SizeOf(fBuf), ReadLen);  
                        //смотрим ск-ко осталось докачать  
                        InternetQueryDataAvailable(hfile, fSize,0,0);  
                        s := '';  
                        SetString(S, pchar(@fBuf), ReadLen);//преобразуем массив в сторку  
                        result:=result+s;  
                end;  
                end;  
                if flag=1 then  
                CloseFile(f) //<закроем файл  
                else begin  
                g_Value:=result;  
                PutNParam(2,g_Value);//установим значение третьей переменной  
                end;  
                result:='1';  
                end;  
                g_Value:=StrToInt(result);//Установим возвращаемое функцией  
                //конец получения страницы  
                InternetCloseHandle(hfile);//закроем сессию  
                InternetCloseHandle(hsession);  
        end;  
      end;  
    end;//case  

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

Попытка  
             vk = СоздатьОбъект("AddIn.GetURL");  
Исключение  
             Сообщить("Не удается создать объект AddIn.GetURL... !!");  
             Сообщить("Зайдите в Windows под правами локального администратора и повторите попытку.");     
  
КонецПопытки;      
  
Ф = СокрЛП(СТР);  
Сообщить(vk.ПолучитьВебСтраницу(фл,СОКРЛП(адр),Ф));   
Стр = Ф;   
vk = 0;  

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

Взаимодействие с чужими окнами

Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!

Для того, чтобы сделать что-нибудь над каким-либо окном нужно сначала получить его дескриптор, т.е. его положение в оперативной памяти. Для этого нужно использовать функцию FindWindow. Ей нужно указать всего два параметра: сначала класс искомого окна, затем его заголовок. Ну с заголовком проблем вообщем-то нет - его мы видим, но вот как определить класс... ведь он скрыт от глас пользователя. В действительности мы может указать только заголовок окна, а вместо класса ставим nil.

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


if FindWindow(nil, 'Безымянный - Блокнот') <> 0 then  
  ShowMessage('Окно найдено')  
else  
  ShowMessage('Окно НЕнайдено'); 

Как мы видим из кода, если наша программа найдёт окно блокнота, мы увидим сообщение, гласящее об этом.

Далее попробуем передвинуть это окно


var  
  h: HWND;  
begin  
  h := findwindow(nil, 'Безымянный - Блокнот');  
  if h <> 0 then  
    SetWindowPos(h, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);  
end;   

Опять находим блокнот. Его дескриптор помещаем в переменную класса HWND[С английского Handle Window - дескриптор окна]. Далее используем функцию SetWindowPos для задания позиции. В качестве параметров нужно указать:

Дескриптор окна, которое хотим переместить
Идентификатор окна, которое предшествует перемещаемому окну в Z-последовательности. Z-последовательность это порядок, в котором формировались окна. Данный параметр указывает с какого именно окна необходимо начинать писк. В качестве значений может принимать либо дескриптор какого-либо окна в системе, либо одно из нижеследующих значений:
HWND_BOTTOM Начало Z-последовательности
HWND_NOTOPMOST Первое окно которое располагается не "поверх все окон"
HWND_TOP Вершина Z-последовательности
HWND_TOPMOST Первое окно которое располагается "поверх все окон"
Позиция окна по горизонтали
Позиция окна по вертикали
Ширина окна
Высота окна
Спецификаторы изменения позиции и размеров окна[флаги]. Для задания значения можно комбинировать следующие константы
SWP_DRAWFRAME Прорисовка фрейма вокруг окна.
SWP_FRAMECHANGED Посылает сообщение WM_NCCALCSIZE окну, даже если размер его не был изменён. Если этот флаг не указан, сообщение WM_NCCALCSIZE будет посылаться, только после изменения размеров окна.
SWP_HIDEWINDOW Скрывает окно.
SWP_NOACTIVATE Не активизирует окно. Если же этот флаг не будет поставлен, окно активизируется и будет перемещено поверх всех окон. А вот встанет ли окно даже выше тех окон, которым задано HWND_TOPMOST или нет зависит от параметра hWndInsertAfter.
SWP_NOCOPYBITS Если этот спецификатор не будет установлен, тогда содержимое клиентской области окна будет скопировано и вставлено во вновь отобразившееся окно после его перемещения.
SWP_NOMOVE Сообщает, что нужно игнорировать параметры задания позиции окну.
SWP_NOOWNERZORDER Сообщает, что не следует изменять позицию окна владельца в Z-последовательности.
SWP_NOREDRAW Не перерисовывает окно.
SWP_NOREPOSITION Такой же как и SWP_NOOWNERZORDER.
SWP_NOSENDCHANGING Мешает окну получить сообщение WM_WINDOWPOSCHANGING.
SWP_NOSIZE Сообщает, что нужно игнорировать параметры задания размеров окну.
SWP_NOZORDER Сохраняет текущее положение в Z-последовательности (игнорирует сообщение hWndInsertAfter parameter).
SWP_SHOWWINDOW Отображает окно.
Если данная функция выполнится успешно, она возвратит отличное от нуля значение. Ну, вот, теперь мы можем передвигать и изменять в размерах чужие окна!!! Для того, чтобы изменить заголовок окна напишем следующий код:


SetWindowText(FindWindow(nil, 'Безымянный - Блокнот'),  
'Дарова, ламерюга, типа ты попал... '); 

Функции setwindowtext нужно указать только два параметра: это дескриптор нужного окна и новое значение для заголовка. Вот вообщем-то и всё!

Есть ещё одна интересная функция ShowWindow, которая позволяет скрывать или отображать окна. Использовать её нужно так::


ShowWindow(FindWindow(nil, 'Безымянный - Блокнот'), sw_hide); 

В скобках указываем сначала над каким именно окном хотим издеваться, а затем что именно мы хотим с ним сделать. В качестве возможных действий можем указать:

SW_HIDE Скрывает окно и активизирует другое.
SW_MAXIMIZE Разворачивает окно.
SW_MINIMIZE Сворачивает окно.
SW_RESTORE Активизирует и выводит окно. Если окно было развёрнуто или свёрнуто - восстанавливает исходный размер и позицию.
SW_SHOW Активизирует и выводит окно с его оригинальным размером и положением.
SW_SHOWDEFAULT Активизирует с установками, заданными в структуре STARTUPINFO, которая была передана при создании процесса приложением запускающим нужную программу.
SW_SHOWMAXIMIZED Выводит окно в развёрнутом виде.
SW_SHOWMINIMIZED Выводит окно в виде пиктограммы на панели задач.
SW_SHOWMINNOACTIVE Выводит окно в свёрнутом виде на панели задач и не передаёт ему фокус ввода, т.е. окно, которое до этого было активно остаётся активно по прежнему.
SW_SHOWNA Отображает окно в его текущем состоянии. Активное окно остаётся активным по прежнему.
SW_SHOWNOACTIVATE Выводит окно в его последнем положении и с последними используемыми размерами. Активное окно остаётся активным по прежнему.
SW_SHOWNORMAL Выводит окно. Если оно было свёрнуто или развёрнуто - восстанавливает его оригинальные размеры и позицию
Но вся сложность действий заключается в том, что в заголовке Блокнота отслеживается имя текущего файла и использовать значение "Безымянный - Блокнот" мы можем не всегда : (. Тем более это не только в случае с блокнотом... Но есть выход: ведь функции FindWindow для поиска окна мы указываем не только заголовок нужного окна, но ещё его класс. Какой же это выход скажете вы, заголовок окна мы видим, значит знаем, что указывать - а класс окна... в действительности тоже может найти приложив немного усилий!

В пакет Delphi входим специальная утилита для отслеживание всех активных процессов, она называется WinSight32. Вот ею мы и воспользуемся. Запустите её, покопайтесь в списке процессов, ищите строку где значится текущий заголовок нужного окна, например Блокнота, и в левой части этой строки в фигурных скобках вы найдёте имя класса окна. Для блокнота это будет "Notepad". Теперь зная имя класса окна мы можем переписать поиск окна таким способом:


ShowWindow(FindWindow('Notepad', nil), sw_hide);   

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

Есть ещё один замечательный способ передачи команд окнам.- функция PostMessage. Ей в качестве параметров нужно указать:

Дескриптор окна, которому посылается сообщение или следующие значения:
HWND_BROADCAST Сообщение будет послано всем окнам верхнего уровня системы, включая неактивные и невидимые окна, overlapped-окна, и PopUp-окна, но сообщение не будет посылаться дочерним
 окнам. 
NULL Ведёт себя как функция PostThreadMessage с переданным ей dwThreadId параметром. 
Посылаемое сообщение 
Первый параметр сообщения 
Второй параметр сообщения 
Например, если послать сообщение wm_quit блокноту - окно будет закрыто без вывода всяких сообщений о необходимости сохранения!


[DELPHI]PostMessage(FindWindow('Notepad', nil), wm_quit, 0, 0); 

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

Быстрый парсер html кода на Delphi

Что такое парсер? Парсер – это программа, которая парсит текст, по заданному алгоритму.

Что такое парсить? Парсить – анализировать и расставлять символы, входящие в текст в соответствии заложенного алгоритма, например, для удобного восприятия текста программистом.

Для чего нужен парсер? Парсер я использую для приведения html тегов к единой структуре: одинаковый размер букв, новый тег на новой строчке, удаление пустых строк.

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

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

Далее привожу код структурирования тегов, цель работы алгоритма – разместить по 1 тегу на каждую строчку memo. В рабочей версии кода программа загружает Html страницы согласно их вложенности в сайте и парсит их, после чего заменяет их.

Для зашиты от дураков оставлю часть кода, который был в основной программе, для демонстрации просто удалите код под комментариями – ///


unit Unit1;  
interface  
  
uses  
  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
  Dialogs, StdCtrls;  
  
type  
  
  TForm1 = class(TForm)  
    Button7: TButton;  
    Button13: TButton;  
    Memo1: TMemo;  
    Memo2: TMemo;  
    procedure Button7Click(Sender: TObject);  
    procedure Button13Click(Sender: TObject);  
      
  private  
    { Private declarations }  
  
  public  
    { Public declarations }  
  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.Button7Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);   /// рабочая папка  
//poiskpapki;         /// процедура для создания списка файлов в папке.  
       memo2.Clear;  
     ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('>',  str);  
          if  position<>0 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position));  
                           delete(str,1,position);  
                           goto 1;  
                           end;  
        if  position=0    then    memo2.Lines.Add(str);  
         end;  
        memo1.Text:=memo2.Text;  
     ///здесь был код сохранения следующего файла  
  //продолжаем парсить  
  button13.Click;  
end;  
  
procedure TForm1.Button13Click(Sender: TObject);  
label 1;  
var  
i,j,k,g:integer;  
bol:boolean;  
position:integer;  
str:string;  
begin  
//chdir(edit1.Text);     /// рабочая папка  
//poiskpapki;           /// процедура для создания списка файлов в папке.  
          memo2.Clear;  
    ///здесь был код загрузки следующего файла  
     for i:= 0 to memo1.Lines.Count - 1 do  
       begin  
          str:= memo1.Lines;  
          1:  
          position := AnsiPos('<',  str);  
          if  position>1 then  
                           begin  
                           memo2.Lines.Add(copy(str,1,position-1));  
                           delete(str,1,position-1);  
                           goto 1;  
                           end;  
          memo2.Lines.Add(str);  
///здесь был код сохранения следующего файла.  
  end;  
 //продолжаем парсить убираем пустые строки  
 // здесь был код.  
end;  
end.  

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

Что называют парсерами? Я сделал поиск по форуму по ключевому слову – парсер, движок мне предложил ряд тем, в которых обсуждалось использование и применение парсера. Попробую прокомментировать эти темы, и по возможности дать ответ.

26.04.2007, 16:39 на форуме – programmersforum.ru была создана тема – XML Parser с поддержкой XSLT

Я пишу электронный учебник. Текст хранится в XML файле. При загрузке файла строится дерево по главам в TreeView, а сам текст отображается в RichView. И вот надо чтобы текст отображался со всеми ссылками, картинками, мультимедиа и т.д. В данный момент я добиться этого не могу. У меня отображается простой текст

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

27.10.2007, 18:29 на форуме – programmersforum.ru была создана тема – Парсер для обработки тагов

Есть некоторый текст из N символов. В этом тексте содержатся разные таги (table, tr, td, img, a). Нужно этот текст разделить на несколько равных частей, т.е сделать постраничный вывод для этого текста. Возникают такие ситуации, когда при разделении текста половина тага находится в одной части, другая половина находится в другой. Чтобы этого избежать, нужно обрабатывать эти таги. Может быть кто-нибудь подскажет, есть ли готовые решения подобных парсеров или же может кто делал что-то подобное. Буду признателен за любую информацию.

Отвечаю, есть решение, с него и начал эту статью, код представлен выше.

07.01.2008, 00:54 на форуме – programmersforum.ru была создана тема – пример парсинга


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
   Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        Listbox1.Items.Add(IntToStr(TokenInt));  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

Пыталься переделать под String не чего не выходит он в listbox выводит по буквено тоесть слово:
Например
Выведет так:
Н
а
п
р
и
м
е
р


Ответ дали там же на форуме –


procedure TForm1.Button1Click(Sender: TObject);  
var  
  Stream: TStream;  
  s: string;  
begin  
  Stream := TMemoryStream.Create;  
  try  
    { получаем текст области редактирования и помещаем его в поток }  
    s := memo1.Text;  
    Stream.WriteBuffer(s[1], length(s));  
    { сбрасываем стартовую позицию потока и создаем парсер }  
    Stream.Position := 0;  
    with TParser.Create(Stream) do  
    try  
      { "добываем" числа и добавляем их в список }  
      s := '';  
      while Token <> toEOF do  
      begin  
        CheckToken(toInteger); { возбуждаем исключение, если не toInteger }  
        //Listbox1.Items.Add(IntToStr(TokenInt));   -->  
        s := s + IntToStr(TokenInt);  
        NextToken;  
      end;  
    finally  
      Free;  
    end;  
  finally  
    Stream.Free;  
  end;  

Вован вам ответил на ваш вопрос – как сделать, чтобы символы выводились в строку, а не в столбец (упустил, правда, один оператор – Listbox1.Items.Add(s), но это только от того, что торопился вам помочь побыстрее).

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

Бегущий текст

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

Итак, создаем новый Delphi проект. Переходим в окно кода, и после ключевого слова var дописываем:


bm:TBitmap;x,y:Integer;  

Потом опять, переходим на форму, и кидаем компонент TTimer (вкладка system). Свойство Enabled ставим в значение false, а в свойстве interval таймера ставим значение 20.
Далее, создаем обработчик событий OnCreate на форме. В котором прописываем следующий код:


x:=Form1.width/2; //текст будет выводиться посредине формы  
y:=Height+50; //чтобы текст выводился не сразу  
bm:=TBitmap.Create; //создаем объект TBitmap  
bm.Width:=width; //ширина как у формы  
bm.height:=height; //высота как у формы  
bm.PixelFormat:=pf32bit; //32 битный режим изображения  
Canvas.Font.Name:='Times New Roman'; //делаем шрифт Times New Roman  
bm.Canvas.Brush.Color:= $004F4F52; //серый цвет фона bitmap  
bm.Canvas.FillRect(bm.Canvas.ClipRect); //делаем, bitmap стал весь серый  
timer1.Enabled:=True; //включаем таймер  

Далее создаем, обработчик событий OnTimer у таймера и пишем туда следующий код:

y:=y-1;  
if y=-200 then y:=height+10;  
with bm do begin  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y, 'Имя программы:');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+15, 'Автор: Имя Автора');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+30,'Тестеры:                  ');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+45,'Имя тестера');  
Canvas.TextOut(x,y+60,'Имя тестера');  
Canvas.TextOut(x,y+75,'Имя тестера');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+90,'Спасибо:            ');  
Canvas.Font.Color:=clWhite;  
Canvas.TextOut(x,y+105,'Имя');  
Canvas.TextOut(x,y+120,'Имя');  
Canvas.TextOut(x,y+135,'Имя');  
Canvas.TextOut(x,y+150,'Имя');  
Canvas.Font.Color:=$000576DC; //делаем цвет оранжевым  
Canvas.TextOut(x-10,y+165,'Автор.Год');  
Canvas.TextOut(x-10,y+180,'          ');  
end;  
Canvas.Draw(0,0,bm); //вырисовываем на форме объект Bitmap  

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


if y=-200 then y:=height+10;  

это означает, что если текст вышел вверх на высоту -200 пикселей, то значение y будет высота формы+10, чтобы текст опять ехал вверх.

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

Ассемблер в Delphi

Основное предназначение этой статьи, заполнить пробелы в оригинальной документации по Borland Delphi Developer, при этом весь программный код, а так же теория, полность совместимы со всеми версиями Delphi.

Основное направление статьи, это познакомиться с использованием ассемблера в Object Pascal. Однако, не будем пропускать и те аспекты программирования, которые будут требовать пояснения для конкретных примеров, приведённых в этой статье.

Использование Ассемблера в Борландовком Delphi

Перед тем, как начать, хотелось бы определиться с уровнем знаний, необходимых для нормального усвоения данного материала. Необходимо быть знакомым со встроенными средствами отладки в Delphi. Так же необходимо иметь представление о таких терминах как тип реализации (instantiation), null pointer и распределение памяти. Если в чём-то из вышеупомянутого Вы сомневаетесь, то постарайтесь быть очень внимательны и осторожны при воплощении данного материала на практике. Кроме того, будет обсуждаться только 32-битный код, так что понадобится компилятор не ниже Delphi 2.0.

Зачем использовать Ассемблер? На мой взгляд, Object Pascal, это инструмент, позволяющий генерировать быстрый и эффективный код, однако использование ассемблера в некоторых случаях позволяет решать некоторые задачи более эффективно. За всю работу с Delphi, я пришёл к выводу, что использование низкоуровневого кода необходимо в двух случая.

(1) Обработка большого количества данных. Nb. В данный случай не входит ситуация, когда используется язык запроса данных.

(2) В высокоскоростных подпрограммах работы с дисплеем. Nb. Имеется ввиду использование простых процедур на чистом паскале, но никак не внешних библиотек и DirectX.

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

Что такое Ассемблер? Надеюсь, что Все читатели этой статьи имеют как минимум поверхностное представление о работе процессора. Грубо говоря, это калькулятор с большим объёмом памяти. Память, это не более чем упорядоченная последовательнось двоичных цифр. Каждая такая цифра является байтом. Каждый байт может содержать в себе значение от 0 до 255, а так же имеет свой уникальный адрес, при помощи которого процессор находит нужные значения в памяти. Процессор так же имеет набор регистров (это можно расценить как глобальные переменные). Например eax,ebx,ecx и edx, это универсальные 32-битные регистры. Это значит, что самое большое число, которое мы можем записать в регистр eax, это 2 в степени 32 минус 1, или 4294967295.

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

05/0a/00/00/00
Однако, такая запись абсолютно не читабельна и, как следствие, не пригодна при отладке программы. Так вот Ассемблер, это простое представление машинных команд в более удобном виде. Теперь давайте посмотрим, как будет выглядеть прибавление 10 к eax в ассемблерном представлении:


add eax,10 {a := a + 10}   

А вот так выглядит вычитаение значения ebx из eax


sub eax,ebx {a := a - b }  

Чтобы сохранить значние, можно просто поместить его в другой регистр


mov eax,ecx {a := c }  

или даже лучше, сохранить значение по определённому адресу в памяти


mov [1536],eax {сохраняет значение eax по адресу 1536}  

и конечно же взять его от туда


mov eax,[1536]   

Однако, тут есть важный момент, про который забывать не желательно. Так как регистр 32-битный(4 байта), то его значение будет записано сразу в четыре ячейки памяти 1536, 1537, 1538 и 1539.

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


Count := 0;   

Для компилятора это означает, что надо просто запомнить значение. Следовательно, компилятор генерирует код, который сохраняет значение в памяти по определённому адресу и следит, чтобы не произошло никаких накладок, и обзывает этот адрес как 'Count'. Вот как выглядит такой код


mov eax,0   

mov Count,eax
Компилятор не может использовать строку типа


mov Count,0   

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


Count := Count + 1;   

то


mov eax,Count   
add eax,1   
mov Count,eax  

Для переменных, тип которых отличается от целого, всё усложняется. Однако, рассмотрим эту тему немного позже, а сейчас предлагаю закрепить теорию практическими примерами.

Итак, рассмотрим первый пример. Сразу извинюсь за тривиальность, но с чего-то надо начинать.


function Sum(X, Y: integer): integer;  
begin   
 Result := X + Y;   
end;  

А вот так будет выглядеть оперция сложения двух целых чисел на ассемблере:


function Sum(X,Y:integer):integer;   
begin   
 asm  
  mov eax,X  
  add eax,Y  
  mov Result,eax  
 end;  
end;  

Этот код прекрасно работает, однако он не даёт нам преимущества в скорости, а так же потерялось восприятие кода. Но не стоит огорчаться, так как те немногие знания, которые Вы почерпнули из этого материала, можно использовать с большей пользой. Допустим, нам необходимо преобразовать явные значения Red,Green, и Blue в цвета типа TColor, подходящие для использования в Delphi. Тип TColor описан как 24-битный True Colour хранящийся в формате целого числа, то есть четыре байта, старший из которых равен нулю, а далее по порядку красный, зелёный, синий.


function GetColour(Red,Green,Blue:integer):TColor;   
begin   
 asm  
{ecx будет содержать значение TColor}  
  mov ecx,0   
{начинаем с красной компоненты}  
  mov eax,Red   
{необходимо убедиться, что красный находится в диапазоне 0<=Red<=255}  
  and eax,255   
{сдвигаем значение красного в правильное положение}  
  shl eax,16   
{выравниваем значение TColor}  
  xor ecx,eax   
{проделываем тоже самое с зелёным}  
  mov eax,Green   
  and eax,255  
  shl eax,8  
  xor ecx,eax  
{и тоже самое с синим}  
  mov eax,Blue   
  and eax,255  
  xor ecx,eax  
  mov Result, ecx  
 end;  
end;  

Заметьте, что я использовал несколько бинарных операций. Эти операции также определены непосредственно в Object Pascal

Автор: Ian Hodger

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

Алгоритмы сортировки

Алгоритм 1. Сортировка вставками.
Это изящный и простой для понимания метод. Вот в чем его суть: создается новый массив, в который мы последовательно вставляем элементы из исходного массива так, чтобы новый массив был упорядоченным. Вставка происходит следующим образом: в конце нового массива выделяется свободная ячейка, далее анализируется элемент, стоящий перед пустой ячейкой (если, конечно, пустая ячейка не стоит на первом месте), и если этот элемент больше вставляемого, то подвигаем элемент в свободную ячейку (при этом на том месте, где он стоял, образуется пустая ячейка) и сравниваем следующий элемент. Так мы прейдем к ситуации, когда элемент перед пустой ячейкой меньше вставляемого, или пустая ячейка стоит в начале массива. Помещаем вставляемый элемент в пустую ячейку . Таким образом, по очереди вставляем все элементы исходного массива. Очевидно, что если до вставки элемента массив был упорядочен, то после вставки перед вставленным элементом расположены все элементы, меньшие его, а после — большие. Так как порядок элементов в новом массиве не меняется, то сформированный массив будет упорядоченным после каждой вставки. А значит, после последней вставки мы получим упорядоченный исходный массив. Вот как такой алгоритм можно реализовать на языке программирования Pascal:


Program InsertionSort;  
Var A,B   : array[1..1000] of integer;  
    N,i,j  : integer;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 for i:=1 to N do  
 begin  
  j:=i;  
  while (j>1) and (B[j-1]>A[i]) do  
   begin  
    B[j]:=B[j-1];  
    j:=j-1;  
   end;  
  B[j]:=A[i];  
 end;  
 {Вывод массива B}  
 …  
End.   

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

Алгоритм 2. Пузырьковая сортировка.
Реализация данного метода не требует дополнительной памяти. Метод очень прост и состоит в следующем: берется пара рядом стоящих элементов, и если элемент с меньшим индексом оказывается больше элемента с большим индексом, то мы меняем их местами. Эти действия продолжаем, пока есть такие пары. Легко понять, что когда таких пар не останется, то данные будут отсортированными. Для упрощения поиска таких пар данные просматриваются по порядку от начала до конца. Из этого следует, что за такой просмотр находится максимум, который помещается в конец массива, а потому следующий раз достаточно просматривать уже меньшее количество элементов. Максимальный элемент как бы всплывает вверх, отсюда и название алгоритма Так как каждый раз на свое место становится по крайней мере один элемент, то не потребуется более N проходов, где N — количество элементов. Вот как это можно реализовать:


Program BubbleSort;  
Var A    : array[1..1000] of integer;  
    N,i,j,p : integer;         
Begin  
 {Определение размера массива A (N) и его заполнение}  
 …  
 {сортировка данных}  
 for i:=1 to n do  
  for j:=1 to n-i do  
  if A[j]>A[j+1] then  
   begin  {Обмен элементов}  
    p:=A[j];  
    A[j]:=A[j+1];  
    A[j+1]:=P;  
   end;  
 {Вывод отсортированного массива A}  
 …  
End.  

Алгоритм 3. Сортировка Шейкером.
Когда данные сортируются не в оперативной памяти, а на жестком диске, особенно если ключ связан с большим объемом дополнительной информации, то количество перемещений элементов существенно влияет на время работы. Этот алгоритм уменьшает количество таких перемещений, действуя следующим образом: за один проход из всех элементов выбирается минимальный и максимальный. Потом минимальный элемент помещается в начало массива, а максимальный, соответственно, в конец. Далее алгоритм выполняется для остальных данных. Таким образом, за каждый проход два элемента помещаются на свои места, а значит, понадобится N/2 проходов, где N — количество элементов. Реализация данного алгоритма выглядит так:


Program ShakerSort;  
Var A       : array[1..1000] of integer;  
    N,i,j,p    : integer;         
    Min, Max : integer;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {сортировка данных}  
 for i:=1 to n div 2 do  
  begin  
   if A[i]>A[i+1] then  
   begin  
    Min:=i+1;  
    Max:=i;  
   end  
   else  
   begin  
    Min:=i;  
    Max:=i+1;  
   end;  
   for j:=i+2 to n-i+1 do  
   if A[j]>A[Max] then  
    Max:=j  
   else  
   if A[j]<A[Min] then  
    Min:=j;   
   {Обмен элементов}  
    P:=A[i];  
    A[i]:=A[min];  
    A[min]:=P;  
    if max=i then  
    max:=min;  
    P:=A[N-i+1];  
    A[N-i+1]:=A[max];  
    A[max]:=P;  
  end;  
 {Вывод отсортированного массива A}  
 …  
End.  

Рассмотрев эти методы, сделаем определенные выводы. Их объединяет не только то, что они сортируют данные, но также и время их работы. В каждом из алгоритмов присутствуют вложенные циклы, время выполнения которых зависит от размера входных данных. Значит, общее время выполнения программ есть O(n2) (константа, умноженная на n2). Следует отметить, что первые два алгоритма используют также O(n2) перестановок, в то время как третий использует их O(n). Отсюда следует, что метод Шейкера является более выгодным для сортировки данных на внешних носителях информации.

Если вы думаете, что бравые «алгоритмщики» остановились на достигнутом, то вы ошибаетесь. Видите ли, временная оценка O(n2) показалась им слишком громоздкой, и они, жадины такие, решили еще потратить свое время, чтобы впоследствии сэкономить наше. Итак, давайте теперь рассмотрим более быстрые алгоритмы.

Алгоритм 4. Сортировка слиянием.
Эта сортировка использует следующую подзадачу: есть два отсортированных массива, нужно сделать (слить) из них один отсортированный. Алгоритм сортировки работает по такому принципу: разбить массив на две части, отсортировать каждую из них, а потом слить обе части в одну отсортированную. Корректность данного метода практически очевидна, поэтому перейдем к реализации.


Program SlivSort;  
Var A,B : array[1..1000] of integer;  
    N  : integer;   
Procedure Sliv(p,q : integer); {процедура сливающая массивы}  
Var r,i,j,k : integer;  
Begin  
 r:=(p+q) div 2;  
 i:=p;  
 j:=r+1;  
 for k:=p to q do  
 if (i<=r) and ((j>q) or (a[i]<a[j])) then  
  begin   
   b[k]:=a[i];  
   i:=i+1;  
  end  
 else  
  begin  
   b[k]:=a[j];  
   j:=j+1;  
  end ;  
 for k:=p to q do  
  a[k]:=b[k];  
End;  
Procedure Sort(p,q : integer); {p,q — индексы начала и конца сортируемой части массива}  
Begin  
 if p<q then {массив из одного элемента тривиально упорядочен}  
 begin  
  Sort(p,(p+q) div 2);  
  Sort((p+q) div 2 + 1,q);  
  Sliv(p,q);  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {запуск сортирующей процедуры}  
 Sort(1,N);  
 {Вывод отсортированного массива A}  
  …  
End.  

Чтобы оценить время работы этого алгоритма, составим рекуррентное соотношение. Пускай T(n) — время сортировки массива длины n, тогда для сортировки слиянием справедливо T(n)=2T(n/2)+O(n) (O(n) — это время, необходимое на то, чтобы слить два массива). Распишем это соотношение:

T(n)=2T(n/2)+O(n)=4T(n/4)+2O(n/2)+O(n)=4T(n/4)+2O(n)= … = 2kT(1)+kO(n)
Осталось оценить k. Мы знаем, что 2k=n, а значит k=log2n. Уравнение примет вид T(n)=nT(1)+ log2nO(n). Так как T(1) — константа, то T(n)=O(n)+log2nO(n)=O(nlog2n). То есть, оценка времени работы сортировки слиянием меньше, чем у первых трех алгоритмов (я прошу прощения у тех, кто не понял мои рассуждения или не согласен с ними, — просто поверьте мне на слово). Перед тем как объяснить, чем этот метод лучше, рассмотрим еще один алгоритм.

Алгоритм 5. Сортировка двоичной кучей
Проблема первых трех алгоритмов, описанных в прошлой части статьи, состояла в том, что после того как элемент занимал свое место, информация об уже произведенных сравнениях никак не использовалась. Структура двоичного дерева позволяет сохранить эту информацию. Итак, представим массив в виде дерева (Рис. 1). Корень дерева — элемент с индексом 1; элемент с индексом i является «родителем» для элементов с индексами 2*i и 2*i+1, а те, в свою очередь, являются его «детьми». Каждый элемент кроме первого имеет «родителя» и может иметь до двух «детей» — речь ведь идет именно о ДВОИЧНОМ дереве. Очевидно, что корнем дерева является наименьший элемент, а наибольший не имеет детей. Тут возникают два вопроса: как нам такую кучу наплодить? И зачем нам это вообще нужно? Пренебрегая порядком, отвечу сразу на второй вопрос: мы хотим извлечь из кучи минимальный элемент, а потом как-то преобразовать и восстановить кучу. Таким образом, по очереди извлечь все элементы и получить отсортированный массив. И вот как мы собираемся это сделать: пусть поддеревья с корнями 2*i и 2*i+1 уже имеют свойство кучи, мы же хотим, чтобы такое свойство имело и поддерево с корнем i. Для этого, если корень больше наименьшего своего «ребенка», мы меняем корень дерева (элемент с индексом i) с этим «ребенком», после повторяем алгоритм для поддерева, куда перешел бывший корень. Выполняя этот алгоритм «снизу вверх» (сначала для маленьких поддеревьев, потом для больших), мы добьемся того, что свойство кучи будет выполняться для всего дерева. Извлечение элемента происходит очень простым способом: мы ставим последний элемент на первое место и запускаем алгоритм исправления кучи от корня дерева… Я тут много наговорил, но на самом деле, реализация совсем несложная:


Program HeapSort;  
Var A,B  : array[1..1000] of integer;  
    N,i,P : integer;  
Procedure Heapi(ind : integer); {процедура, формирующая и исправляющяя кучу}  
Var k    : integer;   
Begin  
 k:=ind*2;  
 If k<=N then  
 begin  
  if (k+1<=N) and (A[k]>A[k+1]) then  
  k:=k+1;   
  if A[ind]>A[k] then  
  begin  
   P:=A[ind];  
   A[ind]:=A[k];  
   A[k]:=P;  
   Heapi(k);  
  end;  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {формирование кучи}  
 for i:=N div 2 downto 1 do  
  Heapi(i);  
 {формирование массива B}  
 for i:=1 to N do  
 begin  
  B[i]:=A[1];  
  A[1]:=A[N];  
  N:=N-1;  
  Heapi(1);  
 end;  
 {Вывод отсортированного массива B}  
  …  
End. 

А теперь главное, т. е. оценка сложности. Время работы процедуры исправляющей кучу зависит от высоты дерева. Высота всего дерева равна log2n, значит, время работы процедуры есть O(log2n). Программа состоит из двух частей: формирование кучи и создание отсортированного массива B. Время исполнения каждой из частей не больше O(n log2n) (в каждой части исправляющая процедура вызывается не более n раз). Значит, время работы то же, что и в сортировке слиянием.

Теперь лирическое отступление насчет времени работы. Может, читатель думает, что быстрые алгоритмы сложны в исполнении и проще написать что-то вроде сортировки вставками. Что ж, рассмотрим простой пример: допустим, вы написали сортировку вставками, тщательно, с помощью ассемблера, и время работы получилось 2n2, а какой-нибудь раздолбай написал сортировку слиянием со временем работы 50nlog2n. И тут появилась необходимость отсортировать 1000000 элементов (что в наше время не редкость). Вы использовали крутой компьютер, который делает 108 операций сравнения и перестановки в секунду, а у него компьютер похуже — всего 106 операций в секунду. И вы будете ждать 2*(106)2/108 = 20 000 секунд (приблизительно 5.56 часов), а ваш конкурент — 50*(106)*log2(106)/106 = 1000 секунд (приблизительно 17 минут). Надеюсь, вы проведете это время (5 часов) с пользой для себя и поймете, что хороший алгоритм — быстрый алгоритм :-). Хотя, если вы будете сортировать маленький массив или много маленьких массивов, то 2n2 для вас будет лучше, чем 50nlog2n. Эту закономерность использует один из способов оптимизации сортировки слиянием: сортировать маленькие части массива вставками.

Теперь переходим к самому интересному, а именно к одной из самых быстрых и эффективных из известных сортировок, которая так и называется — «быстрая сортировка».

Алгоритм 6. Быстрая сортировка.
Как и в сортировке слиянием, массив разбивается на две части, с условием, что все элементы первой части меньше любого элемента второй. Потом каждая часть сортируется отдельно. Разбиение на части достигается упорядочиванием относительно некоторого элемента массива, т. е. в первой части все числа меньше либо равны этому элементу, а во второй, соответственно, больше либо равны. Два индекса проходят по массиву с разных сторон и ищут элементы, которые попали не в свою группу. Найдя такие элементы, их меняют местами. Тот элемент, на котором индексы пересекутся, и определяет разбиение на группы. Классическая реализация алгоритма выглядит так:


Program QuickSort;  
Var A  : array[1..1000] of integer;  
    N,T : integer;   
Procedure Sort(p,q : integer); {p,q — индексы начала и конца сортируемой части массива}  
Var i,j,r : integer;  
Begin  
 if p<q then {массив из одного элемента тривиально упорядочен}  
 begin  
  r:=A[p];  
  i:=p-1;  
  j:=q+1;  
  while i<j do  
   begin  
    repeat  
     i:=i+1;  
    until A[i]>=r;  
    repeat  
     j:=j-1;  
    until A[j]<=r;  
    if i<j then  
     begin  
      T:=A[i];  
      A[i]:=A[j];  
      A[j]:=T;  
     end;  
   end;  
  Sort(p,j);  
  Sort(j+1,q);  
 end;  
End;  
Begin  
 {Определение размера массива A — N) и его заполнение}  
 …  
 {запуск сортирующей процедуры}  
 Sort(1,N);  
 {Вывод отсортированного массива A}  
  …  
End.   

Что же делает данный алгоритм таким быстрым? Ну во-первых, если массив каждый раз будет делится на приблизительно равные части, то для него будет верно то же соотношение, что и для сортировки слиянием, т. е. время работы будет O(nlog2n). Это уже само по себе хорошо. Кроме того, константа при nlog2n очень мала, ввиду простоты внутреннего цикла программы. В комплексе это обеспечивает огромную скорость работы. Но как всегда есть одно «но». Вы, наверное, уже задумались: а что если массив не будет делится на равные части? Классическим примером является попытка «быстро» отсортировать уже отсортированный массив. При этом данные каждый раз будут делиться в пропорции 1 к n-1, и так n раз. Общее время работы при этом будет O(n2), тогда как вставкам, для того чтобы «понять», что массив уже отсортирован, требуется всего-навсего O(n). А на кой нам сортировка, которая одно сортирует хорошо, а другое плохо? А собственно, что она сортирует хорошо? Оказывается, что лучше всего она сортирует случайные массивы (порядок элементов в массиве случаен). И поэтому нам предлагают ввести в алгоритм долю случайности. А точнее, вставить randomize и вместо r:=A
; написать r:=A[random(q-p)+p]; т. е. теперь мы разбиваем данные не относительно конкретного, а относительно случайного элемента. Благодаря этому алгоритм получает приставку к имени «вероятностный». Особо недоверчивым предлагаю на своем опыте убедится, что данная модификация быстрой сортировки сортирует любые массивы столь же быстро.

А теперь еще один интересный факт: время O(nlog2n) является минимальным для сортировок, которые используют только попарное сравнение элементов и не использует структуру самих элементов. Тем, кому интересно, откуда это взялось, рекомендую поискать в литературе, доказательство я здесь приводить не намерен, не Дональд Кнут, в конце концов :-). Но вы обратили внимание, что для рассмотренных алгоритмов в принципе не важно, что сортировать — такими методами можно сортировать хоть числа, хоть строки, хоть какие-то абстрактные объекты. Следующие сортировки могут сортировать только определенные типы данных, но за счет этого они имеют рекордную временную оценку O(n).

[B]Алгоритм 7. Сортировка подсчетом.

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


Program CountingSort;  
Var A,B   : array[1..1000] of byte;  
    C     : array[byte] of integer;  
    N,i    : integer;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 for i:=0 to 255 do  
 C[i]:=0;  
 for i:=1 to N do  
 C[A[i]]:=C[A[i]]+1;  
 for i:=1 to 255 do  
 C[i]:=C[i-1]+C[i];  
 for i:=N downto 1 do  
 begin  
  B[C[A[i]]]:=A[i];  
  C[A[i]]:=C[A[i]]-1; {здесь мы избегаем возможности записи двух одинаковых чисел в одну ячейку}  
 end;  
{Вывод массива B}  
 …  
End.  

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

Рассмотрев такое количество сортировок, можно задуматься: а будет ли результат их работы одинаковым? Странный вопрос, ведь все сортировки правильно сортируют данные, так почему же результат работы может быть разным? Хорошо, объясню: меньшие элементы всегда расположены перед большими, но порядок одинаковых элементов может быть нарушен. Если мы сортируем данные, которые состоят из одного ключа, то мы, конечно, не заметим разницы. Но если к ключу прилагается дополнительная информация, то одна сортировка может вернуть нам 1977 "Иванов" и 1977 "Сидоров", а другая — 1977 "Сидоров" и 1977 "Иванов". Значит, порядок одинаковых элементов может в процессе сортировки стать другим. Правда, это бывает далеко не всегда и не в каждой сортировке. В сортировках вставками, пузырьком, подсчетом и слиянием порядок элементов с одинаковыми ключами всегда такой же, как и в изначальном массиве. Такие сортировки называются устойчивыми, и сейчас я познакомлю вас с улучшенной сортировкой подсчетом, которая позволяет сортировать числа большего диапазона, используя другую устойчивую сортировку.

Алгоритм 8. Цифровая сортировка.
Этой сортировкой можно сортировать целые неотрицательные числа большого диапазона. Идея состоит в следующем: отсортировать числа по младшему разряду, потом устойчивой сортировкой сортируем по второму, третьему, и так до старшего разряда. В качестве устойчивой сортировки можно выбрать сортировку подсчетом, в виду малого времени работы. Реализация такова:


Program RadixSort;  
Var A,B   : array[1..1000] of word;  
   N,i    : integer;  
   t      : longint;  
Procedure Sort; {сортировка подсчетом}  
Var C    : array[0..9] of integer;  
    j     : integer;  
Begin  
 For j:=0 to 9 do  
 C[j]:=0;  
 For j:=1 to N do  
 C[(A[j] mod (t*10)) div t]:= C[(A[j] mod (t*10)) div t]+1;  
 For j:=1 to 9 do  
 C[j]:=C[j-1]+C[j];  
 For j:=N downto 1 do  
 begin  
  B[C[(A[j] mod (t*10)) div t]]:=A[j];  
  C[(A[j] mod (t*10)) div t] := C[(A[j] mod (t*10)) div t]-1;  
 end;  
End;  
Begin  
{Определение размера массива A (N) и его заполнение}  
 …  
{сортировка данных}  
 t:=1;  
 for i:=1 to 5 do  
 begin  
  Sort;  
  A:=B;  
  t:= t*10;  
 end;  
{Вывод массива A}  
 …  
End. 

Так как сортировка подсчетом вызывается константное число раз, то время работы всей сортировки есть O(n). Заметим, что таким способом можно сортировать не только числа, но и строки, если же использовать сортировку слиянием в качестве устойчивой, то можно сортировать объекты по нескольким полям.

Теперь вы владеете достаточным арсеналом, чтобы сортировать все что угодно и как угодно. Помните, что выбор нужной вам сортировки зависит от того, какие данные вы будете сортировать и где вы их будете сортировать.
P.S. Все программы рабочие — если, конечно, вам не лень будет заменить три точки на код ввода и вывода массивов :-).

Автор: Владимир ТКАЧУК

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