[novashdima]

Код:

unit Unit1;
{$I+}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  StdCtrls, ComCtrls, ExtCtrls, OleCtrls, SHDocVw, Menus, sDialogs, sSkinManager,
  sStatusBar, sButton, sTreeView, Dialogs, AppEvnts;

type
  TForm1 = class(TForm)
    Button2: TButton;
    WebBrowser1: TWebBrowser;
    sStatusBar1: TsStatusBar;
    sTreeView1: TsTreeView;
    sSaveDialog1: TsSaveDialog;
    sOpenDialog1: TsOpenDialog;
    ApplicationEvents1: TApplicationEvents;
    MainMenu1: TMainMenu;
    HelpItem: TMenuItem;
    InformationItem: TMenuItem;
    AboutItem: TMenuItem;
    AdditionalItems: TMenuItem;
    ImportTreeViewItem: TMenuItem;
    ExportTreeViewItem: TMenuItem;
    OptionItem: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ImportTreeViewItemClick(Sender: TObject);
    procedure ExportTreeViewItemClick(Sender: TObject);
    procedure AboutItemClick(Sender: TObject);
    procedure FileExitItem1Click(Sender: TObject);
    procedure OptionItemClick(Sender: TObject);
    procedure sTreeView1Click(Sender: TObject);
    procedure sOpenDialog1Close(Sender: TObject);
    procedure sSaveDialog1Close(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure FormDestroy(Sender: TObject);
  private
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
  public
    procedure KillProgram(ClassName: PChar; WindowTitle: PChar);
  end;

var
  Form1: TForm1;
  Form3: TForm;
  s,s1,s2,s3:String;
  Hour,Minute,Second:byte;
  SHour,SMinute,SSecond:string[60];
  fname,fname1,fname2,fname3:string[255];
  fpath:string;
  i:Longint;
  res,clas:integer;
  answ:word;
  f,f1,f2,f3:TextFile;
  regim,complication:boolean;
  flag,flag1,flag2,flag3:boolean;

implementation

uses IniFiles, ShellAPI, ABOUT, OPTION;

{$R *.dfm}

procedure TForm1.WMMoving(var Msg: TWMMoving);
var
workArea: TRect;
begin
 workArea := Screen.WorkareaRect;
 with Msg.DragRect^ do
 begin
  if Left < workArea.Left then
  OffsetRect(Msg.DragRect^, workArea.Left - Left, 0) ;
  if Top < workArea.Top then
  OffsetRect(Msg.DragRect^, 0, workArea.Top - Top) ;
  if Right > workArea.Right then
  OffsetRect(Msg.DragRect^, workArea.Right - Right, 0) ;
  if Bottom > workArea.Bottom then
  OffsetRect(Msg.DragRect^, 0, workArea.Bottom - Bottom) ;
 end;
inherited;
end;

procedure TForm1.sOpenDialog1Close(Sender: TObject);
var MainHandle: THandle;
 begin
 if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
end;

procedure TForm1.sSaveDialog1Close(Sender: TObject);
var MainHandle: THandle;
 begin
 if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
end;

procedure TForm1.sTreeView1Click(Sender: TObject);
begin
 s3:= sTreeView1.Selected.Text;
 fname3:=s3+'.html';
 AssignFile(f3,fname3);
 {$I-}
 Reset(f3);
 res:=IOResult;
 if res = 0 then WebBrowser1.Navigate(webbrowser1.Path+fpath+fname3);
 if res = 2 then WebBrowser1.Navigate(webbrowser1.Path+fpath+fname3);
 if res = 1 then WebBrowser1.Navigate(webbrowser1.Path+'1.html');
 closefile(f3);
 {$I+}
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);
 Params.Style:=Params.Style xor WS_SIZEBOX;
end;

procedure TForm1.ImportTreeViewItemClick(Sender: TObject);
var MainHandle: THandle;
begin
  sOpenDialog1.Execute;
  if sOpenDialog1.Files.Count=0 then exit;
  sTreeView1.LoadFromFile(sOpenDialog1.FileName);
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
 end;

procedure TForm1.OptionItemClick(Sender: TObject);
var MainHandle: THandle;
begin
 OptionForm.Visible:=true;
 OptionForm.SetFocus;
 if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
end;

procedure TForm1.AboutItemClick(Sender: TObject);
begin
 AboutBox.ShowModal;
end;

procedure TForm1.ExportTreeViewItemClick(Sender: TObject);
var MainHandle: THandle;
begin
 sSaveDialog1.Execute;
 if sSaveDialog1.Files.Count=0 then exit;
 if sSaveDialog1.FilterIndex=1 then sSaveDialog1.FileName:=sSaveDialog1.FileName+'.txt';
 sTreeView1.SaveToFile(sSaveDialog1.FileName);
 if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 close;
end;

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
E:=nil;
end;

procedure TForm1.FileExitItem1Click(Sender: TObject);
begin
 close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OptionForm.Destroy;
  Destroy;
  Killprogram(nil,'Химик');
 end;

procedure TForm1.FormCreate(Sender: TObject);
var lt: TSYSTEMTIME;
    Ini:TIniFile;
begin
  Ini:=TiniFile.Create((extractfilepath(Application.ExeName)+'\Options.ini'));
  Application.CreateForm(TOptionForm, OptionForm);
  OptionForm.CloseQuery;
  //прозрачность окон
 OptionForm.TransparentComboBox.Text:=IntToStr(100-round(Ini.ReadInteger('View','Alpha_Blend_Value',10)/2.55));
 //прозрачность окон
 //выход окна за пределы рабочего окна
 OptionForm.LimitComboBox.Enabled:=Ini.ReadBool('View','Windows_Move_Limit',false);
 //выход окна за пределы рабочего окна
 //сохранение настроек выбора режима
 OptionForm.PropertiesCheckBox.Checked:=Ini.ReadBool('Properties','Properties_Save',true);
 //сохранение настроек выбора режима
 //положение окон
 OptionForm.LocationCheckBox.Checked:=Ini.ReadBool('View','Windows_Location_Save',false);
 if Ini.ReadBool('View','Windows_Location_Save',false)=true
 then begin
      Left:=Ini.ReadInteger('View','Windows_Location_Left',0);
      Top:=Ini.ReadInteger('View','Windows_Location_Top',0);
      end;
 //положение окон
end;

procedure TForm1.FormDestroy(Sender: TObject);
var MainHandle: THandle;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
  MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
  SetProcessWorkingSetSize(MainHandle, DWORD(-1), DWORD(-1));
  CloseHandle(MainHandle);
  end;
end;

procedure TForm1.KillProgram(ClassName: PChar; WindowTitle: PChar);
const
 PROCESS_TERMINATE = $0001;
var
 ProcessHandle:THandle;
 ProcessID:Integer;
 TheWindow:HWND;
begin
 TheWindow:=FindWindow(Classname, WindowTitle);
 GetWindowThreadProcessID(TheWindow, @ProcessID);
 ProcessHandle:=OpenProcess(PROCESS_TERMINATE, FALSE, ProcessId);
 TerminateProcess(ProcessHandle,4);
end;

end.