[sorockinalex]

Код:

unit UChangesMsg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, ComCtrls, UDataModule;

type
  TFChangesMsg = class(TForm)
    YesButton: TButton;
    NoButton: TButton;
    ActionLbl: TLabel;
    ApplyImage: TImage;
    CancelImage: TImage;
    ChangesImage: TImage;
    procedure ShowBox(titles, before, after: string);
    procedure YesButtonClick(Sender: TObject);
    procedure NoButtonClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    //Запрет перемещения формы
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  end;

function ChangesMsg(titles, before, after:string):BOOL;

var
  FChangesMsg: TFChangesMsg;
  titleslbl, beforelbl, afterlbl: array of TLabel;
  titles_, before_, after_: TStringList;

implementation

{$R *.dfm}

procedure TFChangesMsg.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;
  with Message do
    if Result = HTCAPTION then
      Result := HTCLIENT;
end;

function ChangesMsg(titles, before,after:string):BOOL;
begin
  try
    FChangesMsg.ShowBox(titles, before, after);
  finally
    if FChangesMsg.ActionLbl.Caption = 'Yes' then Result:=True;
    if FChangesMsg.ActionLbl.Caption = 'No' then Result:=False;    
  end;
end;  


{----- Процедура вызова сообщения -----}
procedure TFChangesMsg.ShowBox(titles, before, after: string);
var
  Pos: Integer;
  i, h, maxcount, maxh, fontsize, txtheight, betweenrows: cardinal;
begin
  fontsize:=12;
  betweenrows:=3;

  Application.CreateForm(TFChangesMsg, FChangesMsg);

  with FChangesMsg do
  begin
    YesButton.Show;
    NoButton.Show;
    ApplyImage.Show;
    CancelImage.Show;

    //делаем TStringList массивы значений
    titles_:= TStringList.Create();
    before_:= TStringList.Create();
    after_:= TStringList.Create();
    StrBreakApart(titles, '<BR>', titles_);
    StrBreakApart(before, '<BR>', before_);
    StrBreakApart(after, '<BR>', after_);

    //Устанавливаем размеры массивов
    try SetLength(titleslbl, titles_.Count) except showmessage('Ошибка: не удаётся установить размер массива titles') end;
    try SetLength(beforelbl, before_.Count)  except showmessage('Ошибка: не удаётся установить размер массива before') end;
    try SetLength(afterlbl, after_.Count)  except showmessage('Ошибка: не удаётся установить размер массива after') end;

    if titles<>'' then
    begin
      //создаём видимый первый столбец Label для каждого значения
      for i := 0 to High(titleslbl) do
      begin
        titleslbl[i] := TLabel.Create(FChangesMsg);
        titleslbl[i].Parent := FChangesMsg;
        titleslbl[i].Font.Color := clBlack;
        titleslbl[i].Font.Size:=fontsize;
        txtheight:=titleslbl[i].Height;

        //Если значения before и after отличаются - выделяем красным
        try
          if before_[i]<>after_[i] then titleslbl[i].Font.Color := clRed;
        except end;

        titleslbl[i].Top := 8 + i * (txtheight + betweenrows);
        titleslbl[i].Left := 8;
        titleslbl[i].Caption := titles_[i];
      end;
    end;

    //Увеличиваем окно, чтобы корректно рассчитались размеры canvas
    maxcount:=titles_.Count;
    maxh := 8 + maxcount * (txtheight + betweenrows)+14;
    Height:= maxh + 80;
    Width:=2000;


    if before<>'' then
    begin
      //Увеличиваем окно, чтобы корректно рассчитались размеры canvas
      if before_.Count>maxcount then
      begin
        maxcount:=before_.Count;
        maxh := 8 + maxcount * (txtheight + betweenrows)+14;
        Height:= maxh + 80;
      end;

      //создаём невидимый второй столбец Label для каждого значения
      for i := 0 to High(beforelbl) do
      begin
        beforelbl[i] := TLabel.Create(FChangesMsg);
        beforelbl[i].Parent := FChangesMsg;
        beforelbl[i].Font.Color := clBlack;
        beforelbl[i].Font.Size:=fontsize;

        //Если значения before и after отличаются - выделяем красным
        try
          if before_[i]<>after_[i] then beforelbl[i].Font.Color := clRed;
        except end;

        beforelbl[i].Top := 8 + i * (txtheight + betweenrows);
        beforelbl[i].Left := 8;
        beforelbl[i].Caption := before_[i];
      end;
    end;

    if after<>'' then
    begin
      //Увеличиваем окно, чтобы корректно рассчитались размеры canvas
      if after_.Count>maxcount then
      begin
        maxcount:=after_.Count;
        maxh := 8 + maxcount * (txtheight + betweenrows)+14;
        Height:= maxh + 80;
      end;

      //создаём невидимый третий столбец Label для каждого значения
      for i := 0 to High(afterlbl) do
        begin
        afterlbl[i] := TLabel.Create(Self);
        afterlbl[i].Parent := FChangesMsg;
        afterlbl[i].Font.Color := clBlack;
        afterlbl[i].Font.Size:=fontsize;

        //Если значения before и after отличаются - выделяем красным
        try
          if before_[i]<>after_[i] then afterlbl[i].Font.Color := clRed;
        except end;

        afterlbl[i].Top := 8 + i * (txtheight + betweenrows);
        afterlbl[i].Caption := after_[i];
        afterlbl[i].Visible := false;
      end;
    end;

    //Освобождаем массивы за ненадобностью - теперь всё хранится в массиве TLabel
    titles_.Free();
    before_.Free();
    after_.Free();

    // Присваиваем заголовок
    If (before='') and (after<>'') then Caption := 'Добавить?';
    If (before<>'') and (after<>'') then
    begin
      Caption := 'Изменить?';
      ChangesImage.Visible := True;      
    end;
    If (before<>'') and (after='') then Caption := 'Удалить?';

    // Оптимизация размеров окна сообщения
    ChangesImage.Top := trunc(maxh / 2)-7;
    Pos := ClientHeight - 33;
    YesButton.Top := Pos;
    NoButton.Top := Pos;
    ApplyImage.Top:=Pos;
    CancelImage.Top:=Pos;

    ShowModal;
  end;
end;

procedure TFChangesMsg.FormActivate(Sender: TObject);
var
  width, maxwidth, fullwidth: cardinal;
  i: cardinal;
begin

  //Определяем ширины текста первого столбца
  width := 0;
  maxwidth := 0;
  if High(titleslbl)>-1 then
  begin
    for i := 0 to High(titleslbl) do
    begin
      //определяем ширину текущего текста
      width := titleslbl[i].Canvas.TextWidth(titleslbl[i].Caption);
      //запоминаем максимальную ширину
      if width > maxwidth then  maxwidth := width;
    end;
    fullwidth:=8+maxwidth;
  end;

  if High(beforelbl)>-1 then
  begin
    for i := 0 to High(beforelbl) do
    begin
      beforelbl[i].Left := fullwidth+8;
      beforelbl[i].Visible := true;
      //определяем ширину текущего текста
      width := beforelbl[i].Canvas.TextWidth(beforelbl[i].Caption);
      //запоминаем максимальную ширину
      if width > maxwidth then  maxwidth := width;
    end;
    fullwidth:=fullwidth+8+maxwidth;
  end;

  if High(afterlbl)>-1 then
  begin
    if length(afterlbl)<>0 then
    begin
      width := 0;
      maxwidth := 0;
      for i := 0 to High(afterlbl) do
      begin
        ChangesImage.Left := fullwidth+8;
        afterlbl[i].Left := fullwidth +8+25+ 8;
        afterlbl[i].Visible := true;
        //определяем ширину текущего текста
        width := afterlbl[i].Canvas.TextWidth(afterlbl[i].Caption);
        //запоминаем максимальную ширину
        if width > maxwidth then  maxwidth := width;
      end;
      fullwidth:=fullwidth+8+25+8+maxwidth;
    end;
  end;
  if fullwidth<272 then fullwidth:=272;
  NoButton.Left := fullwidth+8-90;
  CancelImage.Left:=fullwidth+8-120;

  FChangesMsg.Width:=fullwidth+16;
  Position:=poDesktopCenter;  
end;

procedure TFChangesMsg.YesButtonClick(Sender: TObject);
begin
  Close;
  ActionLbl.Caption := 'Yes';
end;

procedure TFChangesMsg.NoButtonClick(Sender: TObject);
begin
  Close;
  ActionLbl.Caption := 'No';
end;

procedure TFChangesMsg.FormShow(Sender: TObject);
begin
  try Self.Icon.LoadFromFile(GetCurrentDir+'\icons\tpm.ico') except showmessage('Не найдена иконка tpm.ico') end;
  try ChangesImage.Picture.LoadFromFile(GetCurrentDir+'\icons\arrrght.ico') except showmessage('Не найдена иконка arrrght.ico') end;
  try ApplyImage.Picture.LoadFromFile(GetCurrentDir+'\icons\apply.ico') except showmessage('Не найдена иконка apply.ico') end;
  try CancelImage.Picture.LoadFromFile(GetCurrentDir+'\icons\close.ico') except showmessage('Не найдена иконка close.ico') end;
end;

end.