Построение диаграммы классов по коду

//------------------------------------------------------------------------------
//
// ImageHTML -- Image to ASCII Convertor
// Copyright(C) 2003 Kambiz R. Khojasteh, all rights reserved.
//
//------------------------------------------------------------------------------
 
unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, OleCtrls, SHDocVw, StdCtrls, ExtDlgs, JPEG,
  AppEvnts, Spin;
 
type
  TMainForm = class(TForm)
    InputPanel: TPanel;
    OutputPanel: TPanel;
    InputHeader: THeaderControl;
    OutputHeader: THeaderControl;
    InputClientPanel: TPanel;
    OutputClientPanel: TPanel;
    HTMLPages: TPageControl;
    tsColor: TTabSheet;
    tsASCII: TTabSheet;
    wbColor: TWebBrowser;
    wbASCII: TWebBrowser;
    CmdsPanel: TPanel;
    btnSaveToFile: TButton;
    btnPrint: TButton;
    OpenPictureDialog: TOpenPictureDialog;
    ApplicationEvents: TApplicationEvents;
    FontDialog: TFontDialog;
    Spacer1: TBevel;
    btnSelectImage: TButton;
    ImagePanel: TPanel;
    Image: TImage;
    Spacer2: TBevel;
    ParamsPanel: TPanel;
    stMaxLineWIdth: TStaticText;
    edMaxLineWidth: TEdit;
    lblCharacters: TLabel;
    stSequence: TStaticText;
    edSequence: TEdit;
    stColorMap: TStaticText;
    edColorMap: TEdit;
    btnSelectFont: TButton;
    btnConvert: TButton;
    ImageHash: TShape;
    SaveDialog: TSaveDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean);
//    procedure SplitterCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
    procedure btnSaveToFileClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure btnSelectImageClick(Sender: TObject);
    procedure btnSelectFontClick(Sender: TObject);
    procedure btnConvertClick(Sender: TObject);
    procedure edMaxLineWidthExit(Sender: TObject);
    procedure edMaxLineWidthKeyPress(Sender: TObject; var Key: Char);
//    procedure tsASCIIContextPopup(Sender: TObject; MousePos: TPoint;
 //     var Handled: Boolean);
//    procedure HTMLPagesChange(Sender: TObject);
//    procedure HTMLPagesChange(Sender: TObject);
  private
    AlreadyActivated: Boolean;
    ColorHTML, GrayHTML, ASCIIHTML: String;
    procedure InitWebBrowsers;
    procedure LoadImage(const FileName: String);
    procedure LoadSettingsFromRegistry;
    procedure SaveSettingsToRegistry;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.dfm}
 
uses
  ShellAPI, ActiveX, Clipbrd, Registry, ImageAscii;
 
procedure SetHTML(WebBrowser: TWebBrowser; const HTML: String);
var
  Stream: IStream;
  Handle: HGLOBAL;
  Ptr: PChar;
begin
  if WebBrowser.Document <> nil then
  begin
    Handle := GlobalAlloc(GHND, Length(HTML)+1);
    try
      Ptr := GlobalLock(Handle);
      if Assigned(Ptr) then
      begin
        StrPCopy(Ptr, HTML);
        GlobalUnlock(Handle);
        if CreateStreamOnHGlobal(Handle, True, Stream) = S_OK then
        begin
          with (WebBrowser.Document as IPersistStreamInit) do
          begin
            InitNew;
            Load(Stream);
          end;
        end;
      end;
    finally
      GlobalFree(Handle);
    end;
  end;
end;
 
function GetWebColor(Color: TColor): String;
var
  RGB: Integer;
begin
  RGB := ColorToRGB(Color);
  Result := IntToHex(GetRValue(RGB), 2)
          + IntToHex(GetGValue(RGB), 2)
          + IntToHex(GetBValue(RGB), 2);
end;
 
procedure TMainForm.InitWebBrowsers;
const
  BlankDoc = 'about:blank';
begin
  if wbColor.Document = nil then
    wbColor.Navigate(BlankDoc);
  if wbASCII.Document = nil then
    wbASCII.Navigate(BlankDoc);
end;
 
procedure TMainForm.LoadImage(const FileName: String);
begin
  Image.Picture.LoadFromFile(FileName);
  OpenPictureDialog.FileName := FileName;
  btnConvert.Enabled := True;
  Application.ProcessMessages;
  PostMessage(btnConvert.Handle, BM_CLICK, 0, 0);
end;
 
procedure TMainForm.LoadSettingsFromRegistry;
var
  R: TRegistry;
  WindowBounds: TRect;
begin
  R := TRegistry.Create;
  try
    if R.OpenKeyReadOnly('\Software\DELPHI AREA\ImageHTML') then
    begin
      if R.ValueExists('Window.Bounds') then
      begin
        R.ReadBinaryData('Window.Bounds', WindowBounds, SizeOf(WindowBounds));
        BoundsRect := WindowBounds;
        Realign;
      end;
      if R.ValueExists('Window.Maximized') and R.ReadBool('Window.Maximized') then
        WindowState := wsMaximized;
      if R.ValueExists('MaxLineWidth') then
      begin
        edMaxLineWidth.Tag := R.ReadInteger('MaxLineWidth');
        edMaxLineWidth.Text := IntToStr(edMaxLineWidth.Tag);
      end;
      if R.ValueExists('Map.Sequence') then
        edSequence.Text := R.ReadString('Map.Sequence');
      if R.ValueExists('Map.Table') then
        edColorMap.Text := R.ReadString('Map.Table');
      if R.ValueExists('Font.Name') then
        FontDialog.Font.Name := R.ReadString('Font.Name');
      if R.ValueExists('Font.Size') then
        FontDialog.Font.Size := R.ReadInteger('Font.Size');
      if R.ValueExists('Font.Bold') and R.ReadBool('Font.Bold') then
        FontDialog.Font.Style := Font.Style + [fsBold];
      if R.ValueExists('Font.Italic') and R.ReadBool('Font.Italic') then
        FontDialog.Font.Style := Font.Style + [fsItalic];
      if R.ValueExists('Font.Underline') and R.ReadBool('Font.Underline') then
        FontDialog.Font.Style := Font.Style + [fsUnderline];
      if R.ValueExists('Font.StrikeOut') and R.ReadBool('Font.StrikeOut') then
        FontDialog.Font.Style := Font.Style + [fsStrikeOut];
    end;
  finally
    R.Free;
  end;
end;
 
procedure TMainForm.SaveSettingsToRegistry;
var
  R: TRegistry;
  WindowBounds: TRect;
begin
  R := TRegistry.Create;
  try
    if R.OpenKey('\Software\DELPHI AREA\ImageHTML', True) then
    begin
      WindowBounds := BoundsRect;
      R.WriteBinaryData('Window.Bounds', WindowBounds, SizeOf(WindowBounds));
      R.WriteBool('Window.Maximized', WindowState = wsMaximized);
      R.WriteInteger('MaxLineWidth', edMaxLineWidth.Tag);
      R.WriteString('Map.Sequence', edSequence.Text);
      R.WriteString('Map.Table', edColorMap.Text);
      R.WriteString('Font.Name', FontDialog.Font.Name);
      R.WriteInteger('Font.Size', FontDialog.Font.Size);
      R.WriteBool('Font.Bold', fsBold in FontDialog.Font.Style);
      R.WriteBool('Font.Italic', fsItalic in FontDialog.Font.Style);
      R.WriteBool('Font.Underline', fsUnderline in FontDialog.Font.Style);
      R.WriteBool('Font.StrikeOut', fsStrikeOut in FontDialog.Font.Style);
    end;
  finally
    R.Free;
  end;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(ImagePanel.Handle, True);
  LoadSettingsFromRegistry;
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(ImagePanel.Handle, False);
  SaveSettingsToRegistry
end;
 
procedure TMainForm.ApplicationEventsMessage(var Msg: tagMSG;
  var Handled: Boolean);
var
  ImgFile: String;
begin
  if Msg.message = WM_DROPFILES then
  begin
    SetLength(ImgFile, 1024);
    SetLength(ImgFile, DragQueryFile(Msg.wParam, 0, PChar(ImgFile), Length(ImgFile)));
    LoadImage(ImgFile);
    btnConvert.Enabled := True;
    Handled := True;
  end;
end;
 
procedure TMainForm.FormActivate(Sender: TObject);
begin
  if not AlreadyActivated then
  begin
    AlreadyActivated := True;
    Update;
    InitWebBrowsers;
    if ParamCount > 0 then LoadImage(ParamStr(1))
  end;
end;
 
//procedure TMainForm.SplitterCanResize(Sender: TObject;
//  var NewSize: Integer; var Accept: Boolean);
//begin
//  Accept := NewSize <= Splitter.MinSize;
//end;
 
procedure TMainForm.btnSaveToFileClick(Sender: TObject);
var
  HTMLFile: TextFile;
begin
  SaveDialog.FileName := ChangeFileExt(ExtractFileName(OpenPictureDialog.FileName), '')
                       + '-' + HTMLPages.ActivePage.Caption;
  if SaveDialog.Execute then
  begin
    AssignFile(HTMLFile, SaveDialog.FileName);
    Rewrite(HTMLFile);
    if HTMLPages.ActivePage = tsColor then
      Write(HTMLFile, ColorHTML)
    else if HTMLPages.ActivePage = tsASCII then
      Write(HTMLFile, ASCIIHTML);
    CloseFile(HTMLFile);
  end;
end;
 
procedure TMainForm.btnPrintClick(Sender: TObject);
begin
  if HTMLPages.ActivePage = tsColor then
    wbColor.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER)
  else if HTMLPages.ActivePage = tsASCII then
    wbASCII.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER);
end;
 
procedure TMainForm.btnSelectImageClick(Sender: TObject);
begin
  if OpenPictureDialog.Execute then
    LoadImage(OpenPictureDialog.FileName);
end;
 
procedure TMainForm.btnSelectFontClick(Sender: TObject);
begin
  FontDialog.Execute;
end;
 
procedure TMainForm.btnConvertClick(Sender: TObject);
const
  HTMLHeader = '<HTML><BODY><TABLE BORDER="1" CELLSPACING="0" ALIGN="CENTER" BGCOLOR="#%s"><TR><TD>';
  HTMLFooter = '</TD></TR></TABLE></BODY></HTML>';
begin
  if Image.Picture.Graphic <> nil then
  begin
    Screen.Cursor := crHourGlass;
    try
      // Color
      GraphicToHTML(Image.Picture.Graphic, ColorHTML, edSequence.Text, cmColor,
        edMaxLineWidth.Tag, FontDialog.Font,
        Format(HTMLHeader, [GetWebColor(clBlack)]), HTMLFooter);
      SetHTML(wbColor, ColorHTML);
      // Grayscale
      //GraphicToHTML(Image.Picture.Graphic, GrayHTML, edSequence.Text, cmGrayscale,
      //  edMaxLineWidth.Tag, FontDialog.Font,
      //  Format(HTMLHeader, [GetWebColor(clBlack)]), HTMLFooter);
     // SetHTML(wbGrayscale, GrayHTML);
      // ASCII
      GraphicToHTML(Image.Picture.Graphic, ASCIIHTML, edColorMap.Text, cmMono,
        edMaxLineWidth.Tag, FontDialog.Font,
        Format(HTMLHeader, [GetWebColor(clWhite)]), HTMLFooter);
      SetHTML(wbASCII, ASCIIHTML);
      // Enable command buttons
      btnSaveToFile.Enabled := True;
      btnPrint.Enabled := True; 
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;
 
procedure TMainForm.edMaxLineWidthExit(Sender: TObject);
begin
  edMaxLineWidth.Tag := StrToIntDef(edMaxLineWidth.Text, edMaxLineWidth.Tag);
  edMaxLineWidth.Text := IntToStr(edMaxLineWidth.Tag);
end;
 
procedure TMainForm.edMaxLineWidthKeyPress(Sender: TObject; var Key: Char);
const
  ValidKeys = ['0'..'9', ^X, ^C, ^V, Chr(VK_RETURN), Chr(VK_ESCAPE), Chr(VK_BACK)];
begin
  if not (Key in ValidKeys) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
end;
 
end.

TMainForm = class(TForm)

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, jpeg, ExtCtrls, Grids, ValEdit, StdCtrls, Mask, DateUtils,
  Menus;
 
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    PageControl2: TPageControl;
    TabSheet2: TTabSheet;
    Image1: TImage;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    ValueListEditor1: TValueListEditor;
    TabSheet6: TTabSheet;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    LE1: TLabeledEdit;
    LE2: TLabeledEdit;
    LE3: TLabeledEdit;
    LE4: TLabeledEdit;
    PageControl3: TPageControl;
    TabSheet8: TTabSheet;
    RadioGroup1: TRadioGroup;
    Label1: TLabel;
    MaskEdit1: TMaskEdit;
    Button1: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    Memo1: TMemo;
    TabSheet7: TTabSheet;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    LEK1: TLabeledEdit;
    LEK2: TLabeledEdit;
    LEK3: TLabeledEdit;
    TabSheet9: TTabSheet;
    LEG1: TLabeledEdit;
    Memo2: TMemo;
    UpDown1: TUpDown;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    procedure FormResize(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ValueListEditor1Exit(Sender: TObject);
    procedure PageControl2Change(Sender: TObject);
    procedure MakeNAutos;
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure LEK1Exit(Sender: TObject);
    procedure LEK2Exit(Sender: TObject);
    procedure MakeGroupsRegions;
    procedure PageControl3Change(Sender: TObject);
    procedure LEG1Exit(Sender: TObject);
    procedure LEG1Change(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
  // сюда повносить глобальные переменные, которые заполнить из StringGrid-1-2
 
  M:integer = 6; // число районов, потом откорретировать на StringGrid1.RowCount-1;
  N:integer = 1; // число машин, потом откорретировать из ValueListEditor1
 
  rast:array [1..6,1..6] of integer;
  way:array [1..1000,1..6] of integer; // пункты, последовательность посещений
  Sway:array [1..1000] of int64;       // пройденный путь в каждом варианте
  maxSway:integer; // 120 у нас сейчас, потом можно менять
 
  Volume:integer;   // объем цистерны
  SrTime:real;      // средний час обслуживания, минут
  PercPeople:real;  // средний процент населения, выходящего за водой
  MaxL:integer;     // максимальный объем на 1 чел.
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormResize(Sender: TObject);
var i:integer;
begin
     PageControl1.Width:=ClientWidth;
     PageControl1.Height:=ClientHeight;
     PageControl2.Width:=PageControl1.Width;
     PageControl2.Height:=PageControl1.Height-30;
     PageControl3.Width:=PageControl1.Width;
     PageControl3.Height:=PageControl1.Height-30;
     Image1.Width:=PageControl2.Width;
     Image1.Height:=PageControl2.Height-30;
     with StringGrid2 do begin
          Width:=PageControl2.Width-10;
          RowCount:=StringGrid1.RowCount;
          ColCount:=RowCount;
          DefaultColWidth:=Width div ColCount-2;
          for i:=1 to RowCount-1 do Cells[0,i]:=StringGrid1.Cells[1,i];
          for i:=1 to ColCount-1 do Cells[i,0]:=StringGrid1.Cells[1,i];
          for i:=1 to RowCount-1 do Cells[i,i]:='X';
          Cells[2,1]:='1310';
          Cells[3,1]:='900';
          Cells[4,1]:='1860';
          Cells[5,1]:='4640';
          Cells[6,1]:='4800';
          Cells[1,2]:='1310';
          Cells[3,2]:='803';
          Cells[4,2]:='2420';
          Cells[5,2]:='4175';
          Cells[6,2]:='4530';
          Cells[1,3]:='900';
          Cells[2,3]:='803';
          Cells[4,3]:='295';
          Cells[5,3]:='3520';
          Cells[6,3]:='4050';
          Cells[1,4]:='1860';
          Cells[2,4]:='1390';
          Cells[3,4]:='295';
          Cells[5,4]:='546';
          Cells[6,4]:='1370';
          Cells[1,5]:='4640';
          Cells[2,5]:='4175';
          Cells[3,5]:='3520';
          Cells[4,5]:='546';
          Cells[6,5]:='4920';
          Cells[1,6]:='4800';
          Cells[2,6]:='4530';
          Cells[3,6]:='4050';
          Cells[4,6]:='1370';
          Cells[5,6]:='4920';
     end;
     RadioGroup1.Items.Clear;
     with StringGrid1 do
     for i:=1 to RowCount-1 do RadioGroup1.Items.Add(Cells[1,i]);
     RadioGroup1.ItemIndex:=0;
     Memo1.Width:=PageControl2.Width-Memo1.Left;
     Memo1.Height:=PageControl2.Height-5;
     Memo2.Width:=PageControl2.Width-Memo2.Left;
     Memo2.Height:=PageControl2.Height-Memo2.Top-5;
end;
 
procedure TForm1.FormActivate(Sender: TObject);
begin
     with StringGrid1 do begin
     Cells[0,0]:='№з/п';Cells[1,0]:='Мікрорайон (назва)';Cells[2,0]:='Чисельність, люд.';
     Cells[0,1]:='1';Cells[1,1]:='Саманні';Cells[2,1]:='3325';
     Cells[0,2]:='2';Cells[1,2]:='Мікрорайон';Cells[2,2]:='9392';
     Cells[0,3]:='3';Cells[1,3]:='Приватний сектор';Cells[2,3]:='3870';
     Cells[0,4]:='4';Cells[1,4]:='Центр';Cells[2,4]:='11495';
     Cells[0,5]:='5';Cells[1,5]:='Забалка';Cells[2,5]:='2901';
     Cells[0,6]:='6';Cells[1,6]:='Центральний ринок';Cells[2,6]:='3395';
     end;
     FormResize(Sender);
     ValueListEditor1Exit(Sender);
     PageControl2Change(Sender);
     TrackBar1Change(Sender);
     TrackBar2Change(Sender);
end;
 
procedure TForm1.ValueListEditor1Exit(Sender: TObject);
// заполняем
begin
     with ValueListEditor1 do begin
          N:=StrToInt(Values[Keys[1]]);
          Volume:=StrToInt(Values[Keys[2]]);
          SrTime:=StrToFloat(Values[Keys[3]]);
          PercPeople:=StrToFloat(Values[Keys[4]]);
          MaxL:=StrToInt(Values[Keys[5]]);
     end
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var i,j,k,imin,min,jmin,minutes:integer;
    s,smin:int64;
    p:array[1..6] of integer;
    st:string;
    DT,DT2:TDateTime;
begin
     ValueListEditor1Exit(Sender); // на всякий случай
     with StringGrid2 do
     for i:=1 to M do for j:=1 to M do
         if i = j then rast[i,j]:=0 else
         rast[i,j]:=StrToInt(Cells[j,i]);
     // заполняем варианты
     p[1]:=RadioGroup1.ItemIndex+1;
     if p[1] = 1 then for i:=2 to m do p[i]:=i else
        begin
             k:=1;i:=2;
             repeat
                   p[i]:=k;
                   if p[i] <> p[1] then inc(i);
                   inc(k)
             until i > m;
        end;
     // начальное p = (1,2,3,4,5,6);
     maxSway:=1;
     for j:=1 to m do way[maxSway,j]:=p[j];
     repeat
           i:=0;
           // for k:=m-1 downto 2 do if p[k] < p[k+1] then i:=k+1;
           for k:=2 to m-1 do if p[k] < p[k+1] then i:=k+1;
           // нашли первый элемент, который меньше последующего
           if i > 0 then begin
              j:=i;
              min:=p[j];
              for k:=i to m do if (p[k] > p[i-1]) and (p[k] < min) then
                  begin j:=k;min:=p[j] end;
              // меняем местами i-1 и j
              k:=p[i-1];
              p[i-1]:=p[j];
              p[j]:=k;
              // сортируем по возрастанию от i до m
              for j:=i to m do begin
                  min:=p[j];jmin:=j;
                  for k:=j+1 to m do if p[k] < min then
                      begin jmin:=k;min:=p[jmin] end;
                  if jmin <> j then
                     begin k:=p[j];p[j]:=p[jmin];p[jmin]:=k end;
              end;
              inc(maxSway);
              for j:=1 to m do way[maxSway,j]:=p[j];
           end
     until i = 0;
     // Memo1.Lines.Add(IntToStr(maxSway)); - 120 вариантов
     smin:=0;imin:=0;
     for i:=1 to maxSway do begin
         s:=0;
         for j:=2 to M do s:=s+rast[way[i,j-1],way[i,j]];
         Sway[i]:=s;
         if (imin = 0) or (s < smin) then begin smin:=s;imin:=i end
     end;
     // результат
     // for i:=1 to maxSway do Memo1.Lines.Add(IntToStr(Sway[i]));
     if CheckBox2.Checked then Memo1.Lines.Clear;
     Memo1.Lines.Add('Оптимальний шлях:');
     if CheckBox1.Checked then begin
        st:='';
        for j:=1 to M do
            begin st:=st+'('+IntToStr(way[imin,j])+') '+StringGrid1.Cells[1,way[imin,j]];
                  if j < M then st:=st+' -> ';
            end;
        Memo1.Lines.Add(st)
     end else for j:=1 to M do
         Memo1.Lines.Add('('+IntToStr(way[imin,j])+') '+StringGrid1.Cells[1,way[imin,j]]);
     Memo1.Lines.Add('Пройдено: '+IntToStr(smin)+'м.');
     // начинаем составлять расписание
     Memo1.Lines.Add('Виїзд: '+MaskEdit1.Text);
     DT:=StrToTime(MaskEdit1.Text);
     for j:=1 to M do begin
         // проезд в j-ю точку
         // 40 км/час считаем по городу, переводим в минуты
         if j > 1 then DT:=IncMinute(DT,
         Round(rast[way[imin,j-1],way[imin,j]]/1000/40*60));
         // теперь сколько минут машина стоит
         s:=StrToInt(StringGrid1.Cells[2,way[imin,j]]); // сколько проживает
         DT2:=IncMinute(DT,round(s*PercPeople/100*SrTime));
         Memo1.Lines.Add('('+IntToStr(way[imin,j])+') '+
         StringGrid1.Cells[1,way[imin,j]]+': '+TimeToStr(DT)+' - '+TimeToStr(DT2));
         DT:=DT2;
     end;
     minutes:=MinutesBetween(StrToTime(MaskEdit1.Text),DT);
     Memo1.Lines.Add('Усього: '+
          IntToStr(minutes div 60)+':'+
          IntToStr(minutes mod 60)+' годин.')
end;
 
procedure TForm1.PageControl2Change(Sender: TObject);
// маленький расчет
var s,minutes:int64;
    i,lmax:integer;
    DT:TDateTime;
begin
     if PageControl2.ActivePageIndex <> 2 then exit;
     s:=0;
     // всего жителей в городе
     with StringGrid1 do
          for i:=1 to RowCount-1 do s:=s+StrToInt(Cells[2,i]);
     minutes:=round(s*PercPeople/100*SrTime);
     DT:=EncodeTime(minutes div 60,minutes mod 60,0,0);
     // максимально на 1 человека
     lmax:=(Volume*N) div round(s*PercPeople/100);
     LE1.Text:=IntToStr(minutes);  // сколько минут
     LE2.Text:=TimeToStr(DT);      // сколько часов
     LE3.Text:=IntToStr(s);        // сколько жителей всего
     LE4.Text:=IntToStr(lmax);     // сколько литров на 1 вышедшего
end;
 
procedure TForm1.MakeNAutos;
var litres,minutes,autos:integer;s:int64;
    h,min,sec,msec:word;
    DT:TDateTime;
begin
     if (LE3.Text = '') or (LEK1.Text = '') or (LEK2.Text = '') then exit;
     s:=StrToInt(LE3.Text);
     if s = 0 then exit;
     litres:=StrToInt(LEK2.Text);
     if litres = 0 then exit;
     DT:=StrToTime(LEK1.Text); // наше ограничение по времени
     DecodeTime(DT,h,min,sec,msec);
     autos:=round(litres*(s*PercPeople/100)/Volume);
     minutes:=round(s*PercPeople/100*SrTime); // расчет на 1 машину
     while  (60*h+min)*autos < minutes do inc(autos);
     LEK3.Text:=IntToStr(autos);
end;
 
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
     LEK1.Text:=TimeToStr(EncodeTime(TrackBar1.Position div 60,TrackBar1.Position mod 60,0,0));
     MakeNAutos
end;
 
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
     LEK2.Text:=IntToStr(TrackBar2.Position);
     MakeNAutos
end;
 
procedure TForm1.LEK1Exit(Sender: TObject);
var h,min,sec,msec:word;
begin
     DecodeTime(StrToTime(LEK1.Text),h,min,sec,msec);
     TrackBar1.Position:=60*h+min;
     MakeNAutos
end;
 
procedure TForm1.LEK2Exit(Sender: TObject);
begin
     TrackBar2.Position:=StrToInt(LEK2.Text);
     MakeNAutos
end;
 
procedure TForm1.MakeGroupsRegions;
var r:array [1..10000,1..6] of byte; // 1-есть, 0-нет
    i,j,k,k2,maxr,nautos,imin:integer;
    r1:array [1..6] of byte;
    people:array [1..6] of int64;
    sum:array [1..10000] of int64;
    sumr:array [1..10000] of real;
    s,habinants:int64;
    sr,minsr:real;
    st:string;
    visited:array [1..6] of boolean;
    b:boolean;
begin
     Memo2.Lines.Clear;
     nautos:=StrToInt(LEG1.Text);
     habinants:=StrToInt(LE3.Text);
     // формируем различные варианты компоновки районов 1..M
     randomize;
     maxr:=1;
     k2:=0;
     for j:=1 to M do r[1,j]:=random(2);
     repeat
           inc(k2);
           repeat
                 k:=0;
                 for j:=1 to M do begin r1[j]:=random(2);k:=k+r1[j] end
           until k > 0;
           i:=0;
           repeat
                 k:=0;
                 inc(i);
                 for j:=1 to M do if r[i,j] = r1[j] then inc(k);
           until (i = maxr) or (k = M);
           if k < M then begin
              inc(maxr);
              for j:=1 to M do r[maxr,j]:=r1[j];
              k2:=0
           end;
     until k2 > 1000;
     // Memo2.Lines.Add(IntToStr(maxr));
     Memo2.Lines.Add(IntToStr(nautos));
     for j:=1 to M do people[j]:=StrToInt(StringGrid1.Cells[2,j]);
     for i:=1 to maxr do begin
         s:=0;
         for j:=1 to M do s:=s+r[i,j]*people[j];
         sum[i]:=s;
     end;
     sr:=habinants/nautos;
     for i:=1 to maxr do sumr[i]:=abs(sum[i]-sr);
     // сортируем по возрастанию, типовой алгоритм
     for i:=1 to maxr-1 do begin
         minsr:=sumr[i];imin:=i;
         for j:=i+1 to maxr do
             if sumr[j] < minsr then begin
                minsr:=sumr[j];imin:=j;
             end;
         if imin <> i then begin
            // меняем во всех массивах!
            sumr[imin]:=sumr[i];sumr[i]:=minsr;
            s:=sum[imin];sum[imin]:=sum[i];sum[i]:=s;
            for j:=1 to M do begin
                r1[j]:=r[imin,j];
                r[imin,j]:=r[i,j];
                r[i,j]:=r1[j]
            end;
         end;
     end;
     for i:=1 to maxr do Memo2.Lines.Add(IntToStr(sum[i])+' '+
     IntToStr(r[i,1])+' '+
     IntToStr(r[i,2])+' '+
     IntToStr(r[i,3])+' '+
     IntToStr(r[i,4])+' '+
     IntToStr(r[i,5])+' '+
     IntToStr(r[i,6])+' '+FloatToStr(sumr[i]));
     // первая строка - обязательная, есть всегда
     for j:=1 to M do if r[1,j]=1 then visited[j]:=true else visited[j]:=false;
     i:=1;k:=1;
     repeat
           b:=false;
           if i > 1 then // проверка
               for j:=1 to M do if (r[i,j]=1) and visited[j] then b:=true;
           if not b then begin
              st:=IntToStr(i);
              for j:=1 to M do if r[i,j] > 0 then st:=st+' -> '+StringGrid1.Cells[1,j];
              st:=st+' = '+IntToStr(sum[i]);
              Memo2.Lines.Add(st);
              for j:=1 to M do if r[i,j]=1 then visited[j]:=true;
              inc(k);
           end;
           inc(i);
     until k > nautos;
 
 
end;
 
procedure TForm1.PageControl3Change(Sender: TObject);
begin
     if LEK3.Text='' then LEK3.Text:='1';
     if PageControl3.ActivePageIndex = 2 then LEG1.Text:=LEK3.Text;
     if LEG1.Text = '1' then exit;
     MakeGroupsRegions
end;
 
procedure TForm1.LEG1Exit(Sender: TObject);
begin
     MakeGroupsRegions
end;
 
procedure TForm1.LEG1Change(Sender: TObject);
begin
     if LEG1.Text <> '' then MakeGroupsRegions
end;
 
procedure TForm1.N1Click(Sender: TObject);
begin
     close
end;
 
procedure TForm1.N3Click(Sender: TObject);
// Українська мова
begin
     Caption:='Система підтримки прийняття рішень для розрахунку оптимального забезпечення жителів невеликих міст питною водою в екстремальних випадках';
     N1.Caption:='Вихід';
     N2.Caption:='Мова';
     TabSheet1.Caption:='Вхідні дані';
     TabSheet2.Caption:='Карта міста';
     TabSheet3.Caption:='Загальна інформація';
     TabSheet4.Caption:='Райони та мешканці';
     TabSheet5.Caption:='Таблиця відстаней';
     TabSheet6.Caption:='Розрахунки';
     TabSheet7.Caption:='Кількість машин';
     TabSheet8.Caption:='Одна машина';
     TabSheet9.Caption:='Групування районів';
     // ввести все остальные комоненты, а потом скопировать в другие языки 
end;
 
procedure TForm1.N4Click(Sender: TObject);
// Русский язык
begin
     Caption:='Система поддержки принятия решений для расчета оптимального обеспечения жителей небольших городов питевой водой в экстремальных случаях';
     N1.Caption:='Выход';
     N2.Caption:='Язык';
     TabSheet1.Caption:='Входные данные';
     TabSheet2.Caption:='Карта города';
     TabSheet3.Caption:='Общая информация';
     TabSheet4.Caption:='Районы и жители';
     TabSheet5.Caption:='Таблица расстояний';
     TabSheet6.Caption:='Расчеты';
     TabSheet7.Caption:='Количество машин';
     TabSheet8.Caption:='Одна машина';
     TabSheet9.Caption:='Группирование районов';
 
end;
 
procedure TForm1.N5Click(Sender: TObject);
// English
begin
     Caption:='System...';
     N1.Caption:='Exit';
     N2.Caption:='Language';
     TabSheet1.Caption:='Input data';
     TabSheet2.Caption:='Town''s map';
     TabSheet3.Caption:='General information';
     TabSheet4.Caption:='Areas and habitants';
     TabSheet5.Caption:='Table of length';
     TabSheet6.Caption:='Calculation';
     TabSheet7.Caption:='Number if autos';
     TabSheet8.Caption:='One auto';
     TabSheet9.Caption:='Groupping areas';
 
end;
 
end.