2.12. Свойства разного назначения

Узнать текущее состояние любого управляющего элемента на этапе прогона программы можно с помощью свойства

type TControlState = set of (csLButtonDown, csClicked, csPalette, csReadingState, csAlignmentNeeded, csFocusing, csCreating, csCustomPaint, csDestroyingHandle);

property ControlState: TControlState;

класса TControl.

Элементы множества TControlState имеют следующий смысл:

Свойство

type TControlStyle = set of (csAcceptsControls, csCaptureMouse, csDesignInteractive, csFramed, csClickEvents, csSetCaption, csOpaque, csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible, csReplicatable, csNoStdEvents, csDisplayDraglmage, csReflector, csActionClient, csMenuEvents) ;

property ControlStyle: TControlStyle;

содержит стилевые флаги элемента, имеющие такой смысл:

Контрольные вопросы

1. Какой класс служит базой для создания как видимых, так и невидимых компонентов.

2. Какие компоненты способны получать и обрабатывать сообщения Windows?

3. По каким правилам строится имя компонента в программе?

4. Какие методы предназначены для управления списком Components?

5. Какие компоненты называются родительскими, дочерними?

6. С помощью каких методов можно работать со списком Controls?

7. С помощью каких методов можно расположить компонент над всеми компонентами и убрать обратно, если он частично или полностью перекрывается другими компонентами?

8. Какое свойство у глобального объекта Screen используется для изменения формы указателя для всех окон программы одновременно?

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

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

11. Какой интерфейс в Delphi позволяет компонентам обмениваться данными путем “перетаскивания” их мышью?

Примеры составления программ

1. Иллюстрация технологии Drag&Drop

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

procedure lbOutputDragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

procedure TfmExample.lbOutputDragOver(Sender, Source: TObject; X,

Y: Integer; State: TDragState; var Accept: Boolean);

begin

Accept := True;

lbOutput.Caption := (Source as TComponent).Name

end;

end.

2. Выбор несстандартных цветов

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Panel1: TPanel;

Panel2: TPanel;

ColorDialog1: TColorDialog;

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin

{ Вызываем диалог ColorDialog1 и контролируем его результат:

если его метод Execute возвращает True, пользователь

выбрал нужный цвет: }

if ColorDialog1.Execute then

begin

// Закрашиваем левую панель выбранным цветом:

Panel1.Color := ColorDialog1.Color;

{ Помещаем в Edit1 и в заголовок левой панели шестнадцатеричное

представление цвета: }

Edit1.Text := IntToHex(ColorDialog1.Color,8);

Panel1.Caption := Edit1.Text

end

end;

function HexStrToInt(S: String): Integer;

{Функция преобразует шестнадцатеричное представление S целого числа в тип Integer}

function HDigital(C: Char): Byte;

//Преобразует шестнадцатеричную цифру С в число

begin

case C of

'0'..'9': Result := ord(C)-ord('0');

'A'..'F': Result := ord(C)-ord('A')+10;

else

{Если очередной символ не относится к допустимым для представления шестнадцатеричной цифры, возбуждаем исключительную ситуацию, которая блокирует преобразование и сообщает пользователю об ошибке:}

raise EConvertError.Create

('Недопустимое представление шестнадцатеричного числа');

end;

end; //HDigital

var

k: Integer;

begin //HexStrToInt

Result := 0;

//Удаляем возможный символ-указатель шестнадцатеричного числа:

if S[1]='$' then delete(S,1,1);

//Цикл преобразования строки:

for k := 1 to Length(S) do

Result := Result*16+HDigital(S[k]);

end; //HexStrToInt

procedure TForm1.Button2Click(Sender: TObject);

begin

Panel2.Color := HexStrToInt(Edit1.Text);

Panel2.Caption := Edit1.Text

end;

end.

3. Демонстрация свойств AlphaBlendValue и TransparentColor

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Timer1: TTimer;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

Left: Boolean;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

Left := True;

AlphaBlend := True;

AlphaBlendValue := 255;

Timer1.Enabled := True;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

if Left and (AlphaBlendValue>0) then

AlphaBlendValue := AlphaBlendValue-15;

if AlphaBlendValue=0 then

Left := False;

if not Left then

if AlphaBlendValue<255 then

AlphaBlendValue := AlphaBlendValue+15

else

begin

Timer1.Enabled := False;

AlphaBlend := False

end;

Caption := IntToStr(AlphaBlendValue);

Repaint

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if TransparentColor then

Button2.Caption := 'Включить TransparentColor'

else

Button2.Caption := 'Выключить TransparentColor';

TransparentColor := not TransparentColor

end;

end.

4. Проверка мультимедийного таймера

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

procedure bbRunClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

// Объявление экспортируемых функций:

function timeSetEvent(uDelay, uReolution: UINT; lpTimeProc: Pointer;

dwUser: DWORD; fuEvent: UINT): Integer; stdcall; external 'winmm.dll';

function timeKillEvent(uID: UINT): Integer; stdcall; external 'winmm.dll';

// Обьявление глобальных переменных

var

uEventID: UINT; // Идентификатор события таймера

BegTime: TDateTime; // Засечка времени

Counter: Integer; // Счетчик повторений

Delay: Word; // Период срабатывания

procedure ProcTime(uID, msg: UINT; dwUse, dw1, dw2: DWORD); stdcall;

// Реакция на срабатывание таймера

var

h, m, s, ms: Word; // Переменные для декодирования времени

const

MaxCount = 500; // Количество повторений

begin

timeKillEvent(uEventID); // Останавливаем таймер

Counter := Counter+1; // Наращиваем счетчик

if Counter=MaxCount then // Конец цикла?

begin // - Да: декодируем время

DecodeTime((Time-BegTime)/MaxCount, h, m, s, ms);

fmExample.mmOutput.Lines.Add( // Сообщаем результат

Format('Задано %s ms. Получено %d ms',[fmExample.edInput.Text,ms]));

fmExample.edInput.Text := ''; // Готовим повторение

fmExample.edInput.SetFocus

end else // - Нет: вновь пускаем таймер

uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);

end;

procedure TfmExample.bbRunClick(Sender: TObject);

// Запускает таймер. edInput содержит требуемый период.

begin

// Проверяем задание периода

if edInput.Text='' then Exit;

try

Delay := StrToInt(edInput.Text)

except

ShowMessage('Ошибка ввода числа');

edInput.SelectAll;

edInput.SetFocus;

Exit

end;

Counter := 0; // Сбрасываем счетчик

BegTime := Time; // Засекаем время

// Запускаем таймер:

uEventID := timeSetEvent(Delay,0,@ProcTime,0,1);

if uEventID=0 then

ShowMessage('Ошибка запуска таймера')

end;

procedure TfmExample.FormActivate(Sender: TObject);

begin

edInput.SetFocus

end;

end.

5. Проверка стандартного таймера

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, ExtCtrls;

type

TfmExample = class(TForm)

Panel1: TPanel;

bbRun: TBitBtn;

bbClose: TBitBtn;

edInput: TEdit;

lbOutput: TLabel;

mmOutput: TMemo;

Timer1: TTimer;

procedure bbRunClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

BegTime: TDateTime;

Counter: Integer;

public

{ Public declarations }

end;

var

fmExample: TfmExample;

implementation

{$R *.DFM}

procedure TfmExample.bbRunClick(Sender: TObject);

var

Delay: Word;

begin

// Проверяем задание интервала

if edInput.Text='' then Exit;

try

Delay := StrToInt(edInput.Text);

except

ShowMessage('Ошибка в записи числа');

edInput.SelectAll;

edInput.SetFocus;

Exit

end;

Counter := 0; // Сбрасываем счетчик

Timer1.Interval := Delay; // Устанавливаем интервал

BegTime := Time; // Засекаем время

Timer1.Enabled := True; // Пускаем таймер

Screen.Cursor := crHourGlass

end;

procedure TfmExample.Timer1Timer(Sender: TObject);

var

h, m, s, ms: Word;

begin

Counter := Counter + 1;

if Counter=55 then // 55 - кратно срабатыванию таймера

begin

Timer1.Enabled := False;

DecodeTime((Time-BegTime)/55, h, m, s, ms);

mmOutput.Lines.Add(

Format('Задано %s ms. Получено %d ms.', [edInput.Text, ms]));

edInput.Text := '';

edInput.SetFocus;

Screen.Cursor := crDefault

end;

end;

procedure TfmExample.FormActivate(Sender: TObject);

begin

edInput.SetFocus

end;

end.

Задания для самостоятельного выполнения

1. Объявить одномерный массив (количество элементов 10). Заполнить его числами от 15 до 6. Вывести содержимое массива на экран в компонент Label свойство Caption c пояснениями.

2. Объявить двумерный массив (10х10). Верхнюю половину заполнить 3, нижнюю половину заполнить 5. Результат вывести на экран в компонент Label свойство Caption c пояснениями.

3. Объявить двумерный массив (10х10). По диагонали левую половину заполнить 2, правую половину заполнить 3. Результат вывести на экран в компонент StringGrid свойство Cells.

4. Объявить одномерный массив (количество элементов 15). Заполнить его числами от 1 до 15. Вывести содержимое массива на экран в компонент StringGrid свойство Cells.

5. Объявить двумерный массив (10х10). Верхнюю половину заполнить 3, нижнюю половину заполнить 4. Результат вывести на экран в компонент StringGrid свойство Cells. Задать фиксированные строку и столбец для пояснений индексов массива.

6. Вычислить длину окружности, площадь круга и объём шара одного и того же заданного радиуса. Отобразить на экране в компонент Label свойство Caption c пояснениями.