Добавил:
rn Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
15
Добавлен:
26.05.2018
Размер:
2 Кб
Скачать
unit Ins;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, HTMLHelpViewer;

type
  TFIns = class(TForm)
    PBottom: TPanel;
    BBExit: TBitBtn;
    PTop: TPanel;
    REIns: TRichEdit;
    procedure FormActivate(Sender: TObject);
    procedure REInsKeyPress(Sender: TObject; var Key: Char);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FIns: TFIns;

implementation

{$R *.dfm}

Uses
  Variable;
var
  SizeFont : Integer = 1;
  S  : Byte;

procedure TFIns.FormActivate(Sender: TObject);
var
  ST : String;
begin
  S := 1;
  SetBounds( Left - ClientOrigin.X, Top - ClientOrigin.Y, GetDeviceCaps(
  Canvas.handle, HORZRES ) + (Width - ClientWidth), GetDeviceCaps( Canvas.handle,VERTRES )
  + (Height - ClientHeight ));
  BBExit.Left := 2 * (FIns.Width div 4) - (BBExit.Width div 2);
  REIns.SelAttributes.Size := ClientHeight div (S*8);
  REIns.Font.Size := ClientHeight div (S*8);
  // загрузить текст инструкции
  if testid=1 then
  begin
  PTop.Caption := 'Инструкция к тесту Мюнтсберга';
  ST := '..\materials\Muntsberg.rtf';
  end;
  if testid=2 then
  begin
  PTop.Caption := 'Инструкция к тесту Когана';
  ST := '..\materials\Kogan.rtf';
  end;
  REIns.Lines.LoadFromFile(ST);
  REIns.Visible := False;
  while (SizeFont <= (ClientHeight div (S*2-1)+5)) do
  begin
    S := REIns.Lines.Count;
    REIns.SelectAll;
    REIns.SelAttributes.Size := SizeFont;
    Inc(SizeFont,1);
  end;
  REIns.Visible := True;
  REIns.SelLength := 0;

//  REIns.SetFocus;
{FIns.Caption := 'Инструкция к тесту "Мюнтенсберга":';
  ST := '..\materials\Muntsberg.rtf';
  REIns.Lines.LoadFromFile(ST);
  REIns.Visible := True;}
end;


procedure TFIns.REInsKeyPress(Sender: TObject; var Key: Char);
begin
  //выход из просмотра инструкции по эскейпу
  If Key = #27 then Close;
end;

end.
Соседние файлы в папке Курсовая ( Мюнсберга и Когана )
  • #
    26.05.201819 Кб16Filippse_Half.dcu
  • #
    26.05.201812 Кб15Filippse_Half.dfm
  • #
    26.05.20187 Кб15Filippse_Half.pas
  • #
    26.05.20188 Кб15Ins.dcu
  • #
    26.05.20183 Кб15Ins.dfm
  • #
    26.05.20182 Кб15Ins.pas
  • #
    26.05.2018127 Кб15Kogan.dcu
  • #
    26.05.20184 Мб15Kogan.dfm
  • #
    26.05.201881 Кб15Kogan.pas
  • #
    26.05.201812 Кб15Main.dcu
  • #
    26.05.2018239 Кб15Main.dfm