nyuuzyou/wikis huggingface dataset:
Проблема использования компонентов в D6/7 от предыдущих версий

=== Проблема использования компонентов в D6/7 от предыдущих версий ===
Решение в случае ошибок компиляции пакетов типа: Missing unit 'Proxies.pas' и Missing DsgnIntf.pas
1) Сначала заменить 
 uses DsgnIntf;
на
 uses DesignIntf, DesignEditors;
2) Затем Добавить
 
 DesignIde.dcp
в лист требуемых модулей
Переименование модулей не решит проблемы 'Proxies.pas' Эта проблема возникает из-за того, что сами компоненты и редакторы свойств помещают в один пакет. Это нехорошо, но в D5 и ниже проходило, а начиная с D6 уже не проходит. Пакет разбиваете на два: run-time и design-time. RT-пакет содержит ТОЛЬКО код самих компонентов и больше НИЧЕГО. Ни один его модуль не должен ссылаться в uses ни на один модуль DT-пакета. В его секции Requires могут содержаться ТОЛЬКО run-time модули VCL. Компилируется RT-пакет в любой каталог, доступный через пути поиска IDE, либо через переменную системного окружения Path. Инсталлировать в IDE его не нужно. DT-пакет содержит процедуру Register, иконки компонентов и все design-time редакторы (свойств и компонентов), если такие есть. Любой его модуль может ссылаться в uses на любой модуль из RT-пакета. В его секцию Requires и подключается DesignIDE.dcp. Компилируется он куда угодно и должен инсталлироваться в IDE. Таким образом, в конечные приложения будут подключаться только модули RT-пакета, в которых нет ссылок на DesignEditors - а тогда не потребуется и Proxies. Кроме того, в конечный проект не будут подтягиваться ненужные в run-time код и ресурсы из DT-пакета.
Author: Юрий Зотов
Source: http://www.delphifaq.com
ID: 00058
Проблема передачи записи

=== Проблема передачи записи ===
Может это не то, что вы ищете, но идея такая: 
Определите базовый класс с именем, скажем, allrecs:
TAllrecs = class
 function getVal (field: integer): string; virtual;
end;
Затем создаем классы для каждой записи:
recA = class(TAllrecs)
 this : Integer;
 that : String;
 the_other : Integer;
 function getVal (field: integer): string; virtual;
end;
Затем для каждой функции класса определите возвращаемый результат:
function recA.getVal(field: integer); string;
begin
 case field of
 1: getVal := intToStr (this);
 2: getVal := that;
 3: getVal := intToStr (the_other);
 end;
end;
Затем вы можете определить
function myFunc(rec: tAllrecs; field: integer);
begin
 label2.caption := allrecs.getVal(field);
end;
затем вы можете вызвать myFunc с любым классом, производным от tAllrecs, например:
myFunc (recA, 2);
myFunc (recB, 29);
(getVal предпочтительно должна быть процедурой (а не функцией) с тремя var-параметрами, возвращающими имя, тип и значение.) 
Все это работает, т.к. данный пример я взял из моего рабочего проекта. 
[Sid Gudes, cougar@roadrunner.com] 
Если вы хотите за один раз передавать целую запись, установите на входе ваших функций/процедур тип 'array of const' (убедитесь в правильном приведении типов). Это идентично 'array of TVarRec'. Для получения дополнительной информации о системных константах, определяемых для TVarRec, смотри электронную справку по Delphi. 
Source: http://delphiworld.narod.ru
ID: 00783
Проблема потери фокуса для TEdit

=== Проблема потери фокуса для TEdit ===
To Reproduce the Problem:
1. Drop two TEdits onto a form.
2. In the OnExit Event of Edit1 add the following code:
Application.MessageBox('Title', '...', mb_ok);
3. Run the application.
4. First select Edit1 then Edit2
5. The Message box is shown. Click the OK button, and the Caret has dissapeared!
6. How to handle this:
procedure TForm1.Edit1Exit(Sender: TObject);
begin
 Application.MessageBox('qq', 'qq', mb_ok);
 if Assigned(ActiveControl) then
 PostMessage(ActiveControl.Handle, WM_SETFOCUS, 0, 0);
end;
Language: en
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00974
Проблема с AddIndex

=== Проблема с AddIndex ===
При попытке использования AddIndex я получаю ошибку 'Invalid Index/Tag name. (Неверное имя Индекса/Тэга) Index: cusname'. Но у меня нет никаких проблем с этим именем при использовании DeleteIndex.
Есть глючок-с с именем индексов:
if IndexName = Fieldname then
 ixCaseSensitive is reqd // (по умолчанию)
if IndexName <> Fieldname then
 ixCaseInsensitive is reqd
Таким образом, вам нужно:
InvTbl.AddIndex('cusname', 'name', [ixCaseInsensitive]);
или
InvTbl.AddIndex('name', 'name', []);
Source: http://delphiworld.narod.ru/
ID: 02439
Проблема с освобождением ресурсов Notebook

=== Проблема с освобождением ресурсов Notebook ===
Проблема с использованием ресурсов в компоненте Notebook? Вы можете обойти это, освобождая дескрипторы окон невидимых страниц компонента. Следующий код поясняет как это можно сделать - я создал обработчик события компонента OnClick, освобождающий дескрипторы невидимых страниц при каждом изменении видимой страницы:
procedure TForm1.TabSet1Click(Sender: TObject);
var 
 i: integer;
begin
 Notebook1.PageIndex := TabSet1.TabIndex;
 with Notebook1, Pages do 
 for i := 0 to Count - 1 do
 if (i <> PageIndex) then 
 TForm1(Objects[i]).DestroyHandle;
end;
Как вы могли заметить, я привел тип страницы notebook (Objects[ i ]) к объектам TForm1, что на самом деле не так. Тем не менее, эта небольшая хитрость позволяет иметь доступ к защищенным членам извне метода класса, где они определены, в данном случае DestroyHandle - защищенный метод TWinControl. 
Это работает, поскольку TForm1 является наследником TWinControl, и позволяет иметь доступ к защищенным членам TForm1 и ее наследникам. Быстро и грязно, но это работает! <g> 
Не волнуйтесь, если вы видите, что невидимая страница показывается снова. VCL - довольно умная штука, поскольку захватывает данные от дескриптора окна и сохраняет это непосредственно в объекте. Затем, всякий раз, когда дескриптор требуется снова, то есть тогда, когда вы делаете страницу видимой, дескриптор окна пересоздается, туда снова копируются данные, и оп-ля, как будто ничего и не произошло - магия! 
Source: http://delphiworld.narod.ru/
ID: 01183
Проблема с установками принтера

Обнаружил, что компонент QReport никак не реагирует на установки принтера PrinterSetup диалога, вызываемого нажатием кнопочки собственного Preview!
В QuickReport есть собственный объект TQRPrinter, установки которого он использует при печати, а стандартные установки принтеров на него не влияют. В диалоге PrinterSetup, вызываемом из Preview можно лишь выбрать принтер на который нужно печатать (если, конечно, установлено несколько принтеров).
Советую поставить обновление QReport на 2.0J с www.qusoft.com.
Перед печатью (не только из QReport) программно установите требуемый драйвер принтера текущим для Windows
function SetDefPrn(const stDriver: string): boolean;
begin
 SetPrinter(nil).Free;
 Result := WriteProfileString('windows', device, PChar(stDriver));
end;
После печати восстановите установки.
Источник: http://dmitry9.nm.ru/info/
ID: 03271
Category:Создание отчетов
Проблемы ini-файла

=== Проблемы ini-файла ===
Кто-нибудь имел какие-нибудь проблемы при использовании модуля TIniFile? Я думаю здесь какая-то детская проблема с кэшированием!!!
Вот что я делал:
(* c:\test.ini уже существует *)
myIni := TIniFile.Create('c:\test.ini');
with myIni do
begin
 // .... (добавляем новую секцию в test.ini
end;
myIni.Free;
RenameFile('c:\test.ini', 'c:\test1.ini');
Что я получил:
test1.ini НЕ ИМЕЕТ добавленной мною секции;
всякий раз при создании или открытии нового файла в том же самом каталоге с помощью File Manager, 'c:\test.ini' появляется вновь, и у него СУЩЕСТВУЕТ секция, которую я добавлял.
Я решил эту проблему добавлением следующей строки перед IniFile.Free:
 WritePrivateProfileString(nil, nil, nil, PChar(IniFileName));
Для получения дополнительной информации обратитесь к электронной справке к разделу 'WritePrivateProfileString'
Author: Автор: Tony Chang 
ID: 02308
----
Как указать системе на необходимость сбросить буфер INI-файла на диск
procedure FlushIni(FileName: string);
var
 {$IFDEF WIN32}
 CFileName: array[0..MAX_PATH] of WideChar;
 {$ELSE}
 CFileName: array[0..127] of Char;
 {$ENDIF}
begin
 {$IFDEF WIN32}
 if (Win32Platform = VER_PLATFORM_WIN32_NT) then
 WritePrivateProfileStringW(nil, nil, nil, StringToWideChar(FileName, CFileName, MAX_PATH))
 else
 WritePrivateProfileString(nil, nil, nil, PChar(FileName));
 {$ELSE}
 WritePrivateProfileString(nil, nil, nil, StrPLCopy(CFileName, FileName, SizeOf(CFileName) - 1));
 {$ENDIF}
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02309
Проблемы использования TRegistry под NT/2000/XP

=== Проблемы использования TRegistry под NT/2000/XP ===
При использовании компонента TRegistry под NT пользователь с правами доступа ниже чем "Администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Как это обойти?
Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя функции API для работы с реестром (RegOpenKey и т.п.), или создать новый класс из компонента TRegestry, и изменить его так чтобы можно было задавать режим открытия реестра.
Вообще-то можно ничего не переписывать:
 Reg := TRegistry.Create(KEY_READ);
т.е. у TRegistry есть два конструктора - один без параметра, тогда доступ будет
KEY_ALL_ACCESS, а другой конструктор - с параметром...
Примечание к примечанию Vit
Дополнительные конструкторы появились только в последних версиях Дельфи
Author: p0s0l
ID: 02271
----
Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя вместо TRegistry.OpenKey - TRegistry.OpenKeyReadOnly
В справке про TRegistry указано неверно, что ключ открывается всегда с параметром KEY_ALL_ACCESS. В случае если открывать через TRegistry.OpenKeyReadOnly он откроется с параметром KEY_READ
ID: 02272
Проблемы использования компонента TStoredProc

=== Проблемы использования компонента TStoredProc ===
; Недавно я перешел на использование Oracle, но все мои попытки использовать компонент TStoredProc оказываются неудачными. Почему?
Причины неработоспособности компонента TStoredProc могут быть следующими.
Во-первых, при использовании ODBC-доступа может оказаться, что применяемый вами ODBC-драйвер не поддерживает хранимые процедуры (как известно, не все ODBC-драйверы их поддерживают).
Во-вторых, имеется известная проблема, описание которой содержится в разделе Developers Support корпоративного сайта Inprise (http://www.inprise.com). Дело в том, что число параметров хранимой процедуры, с которой взаимодействует компонент TStoredProc, не должно превышать 10. В случае, если реальное число параметров превышает 10, многие разработчики переписывают хранимые процедуры так, чтобы они использовали строковые параметры, содержащие по несколько реальных параметров.
Author: Наталия Елманова
Source: Взято из http://forum.sources.ru
ID: 02634
Проблемы регистрации Дельфи

===== Проблемы регистрации Дельфи =====
После горячей перезагрузки компьютера Delphi 7 при запуске стала выдавать такое окошечко: Переустановка не помогла. Подскажите, как решить проблему. 
1. С файлом чистки реестра соседствует программа регистрации D7Reg.exe. Она и позволяет ввести ключ заново.
2. Вообще можно просто один раз сохранить файлы из c:\Documents and Settings\username\.borland\ и жить спокойно 
Source: http://forum.sources.ru
ID: 00008
Проблемы с TCanvas.StretchDraw при рисовании иконок

=== Проблемы с TCanvas.StretchDraw при рисовании иконок ===
При попытке использовать метод TCanvas.StretchDraw чтобы нарисовать иконку, увеличенной ее размер не изменяется. Что делать?
Иконки всегда рисуются размером принятым в системе по умолчанию. Чтобы показать увеличенный вид иконки скопируйте ее на bitmap, а затем используйте метод TCanvas.StretchDraw.
procedure TForm1.Button1Click(Sender: TObject);
var
 TheBitmap: TBitmap;
begin
 TheBitmap := TBitmap.Create;
 TheBitmap.Width := Application.Icon.Width;
 TheBitmap.Height := Application.Icon.Height;
 TheBitmap.Canvas.Draw(0, 0, Application.Icon);
 Form1.Canvas.StretchDraw(Rect(0, 0, TheBitmap.Width * 3, TheBitmap.Height * 3), TheBitmap);
 TheBitmap.Free;
end;
ID: 02353
Проблемы с автоинкрементальными полями

=== Проблемы с автоинкрементальными полями ===
Оказывается, что Interbase триггер "before insert" срабатывает только после того, как запись "запостится" из Delphi приложения. В связи с чем становится невозможным увеличение автоинкрементальных ключевых полей. Есть решение?
Большинство программистов решило эту проблему созданием хранимой процедуры (stored procedure), позволяющей от InterBase получить следующий номер и поместить его в вашу запись посредством метода onBeforePost или onNewRecord.
ID: 02911
----
Я пытаюсь сгенерировать последовательный ключ для первичной ключевой колонки, но LIBS мне отвечает "nested select is not support in this context." (вложенный выбор не поддерживается в данном контексте.)
Как насчет:
 CREATE TRIGGER AUTOINCREMENT FOR MYTABLE
 BEFORE INSERT AS
 DECLARE VARIABLE new_key INTEGER;
 BEGIN
 UPDATE AUTOKEYS
 SET KEY_VALUE = KEY_VALUE + 1
 WHERE (KEY_ID = "A");
 SELECT KEY_VALUE
 FROM AUTOKEYS
 WHERE KEY_ID = "A"
 INTO :new_key;
 new.my_key_column = new_key;
 END ^
Author: Steve Koterski (Borland) 
ID: 02912
----
Я пытаюсь добавить запись в таблицу InterBase, содержащую триггеры и blob-поля, тем не менее, всякий раз при выполнении метода "post" после установки ("append") значений, я получаю ошибку: 'Record/Key deleted.' (запись/ключ удален).
Вот реальный пример того, как я обошел эту проблему:
Определение хранимой процедуры:
 Create Procedure NewEmployeeKey Returns ( EmployeeKey Integer ) as
 begin
 EmployeeKey = Gen_Id( gnEmployeeKey, 1 ) ;
 end
Определение триггера:
 Create Trigger SetEmployeeKey for tbEmployee Active Before Insert Position 0 as
 begin
 if ( New.EmployeeKey is Null ) then begin
 Execute Procedure NewEmployeeKey Returning_Values New.EmployeeKey ;
 end
 end
Код Delphi для использования в обработчике события OnNewRecord, или AfterInsert, или BeforePost:
{ qyProviderData - это tQuery }
{ spProviderKey - это tStoredProc }
if qyProviderData.State in [dsInsert] then
begin
 spProviderKey.ExecProc ;
 qyProviderData.FieldByName( 'ProviderKey' ).AsInteger :=
 spProviderKey.ParamByName( 'ProviderKey' ).AsInteger ;
end ; { if }
Это все, что вам необходимо. Хранимая процедура возвращает следующее сгенерированное значение. Триггер это гарантирует, даже если бы данные не были доступны из вашей Delphi-программы, первичный ключ все еще назначает значение. В Delphi-коде, я полагаю, вы могли бы проверять наличие пустого поля первичного ключа вместо .State in [dsInsert], хотя это то же работает.
Author: Mike Downey
Source: Взято с http://delphiworld.narod.ru
ID: 02913
Category:Базы данных
Category:Interbase
Проблемы с дробными числами

=== Проблемы с дробными числами ===
Иногда возникают трудности интерпретации дробных чисел - что есть разделитель точка или запятая?
В Дельфи есть системные переменные:
 DECIMALSEPARATOR - десятичный разделитель который принят в системе
 THOUSANDSEPARATOR - разделитель тысяч, который принят в системе
Для USA регионального стандарта
 DECIMALSEPARATOR будет "."
 THOUSANDSEPARATOR будет ","
Для России
 DECIMALSEPARATOR будет ","
 THOUSANDSEPARATOR будет "." или " " (не помню уже) 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00207
Проблемы с открытием базы данных.

=== Проблемы с открытием базы данных. ===
У меня возникают проблемы с открытием базы данных. USERNAME и PASSWORD вроде-бы правильные.
Может быть, что в момент ввода пароля клавиатура переключена в режим Caps Lock - а пароль является регистрочувствительным. После установки действуют имя пользователя SYSDBA и пароль masterkey. Они предназначены для работы Администратора БД. Из соображений security вы должны изменить пароль masterkey, чтобы никто кроме вас не смог подсоединиться к IB. Также, ни в коем случае нельзя удалять пользователя SYSDBA, иначе вы потеряете доступ к системным таблицам.
Author: Дмитрий Кузьменко (http://www.ibase.ru)
ID: 02896
Category:Базы данных
Category:Interbase
Проверить, выделена ли ячейка TStringGrid

=== Проверить, выделена ли ячейка TStringGrid ===
function IsCellSelected(StringGrid: TStringGrid; X, Y: Longint): Boolean;
begin
 Result := False;
 try
 if (X >= StringGrid.Selection.Left) and (X <= StringGrid.Selection.Right) and
 (Y >= StringGrid.Selection.Top) and (Y <= StringGrid.Selection.Bottom) then
 Result := True;
 except
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if IsCellSelected(stringgrid1, 2, 2) then
 ShowMessage('Cell (2,2) is selected.');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01054
----
Проверить, используется ли формат времени в 24 часа

=== Проверить, используется ли формат времени в 24 часа ===
function Is24HourTimeFormat: Boolean;
var
 DefaultLCID: LCID;
begin
 DefaultLCID := GetThreadLocale;
 Result := (0 <> StrToIntDef(GetLocaleStr(DefaultLCID, LOCALE_ITIME, '0'), 0));
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01650
Проверить, можно ли отменить последнее действие в TMemo

=== Проверить, можно ли отменить последнее действие в TMemo ===
procedure TForm1.Button1Click(Sender: TObject);
begin
 if Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then
 ShowMessage('Undo is possible')
 else
 ShowMessage('Undo is not possible');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01007
Проверить, находится ли курсор на линии

=== Проверить, находится ли курсор на линии ===
{
 Check if a Point(X,Y) (e.g a Cursor) is on a Linie (x1,y1) ; (x2,y2)
 d = line width (min. 1)
}
function CursorOnLinie(X, Y, x1, y1, x2, y2, d: Integer): Boolean;
var
 sine, cosinus: Double;
 dx, dy, len: Integer;
begin
 if d = 0 then d := 1;
 asm
 fild(y2)
 fisub(y1) // Y-Difference
 fild(x2)
 fisub(x1) // X-Difference
 fpatan // Angle of the line in st(0)
 fsincos // Cosinus in st(0), Sinus in st(1)
 fstp cosinus
 fstp sine
 end;
 dx := Round(cosinus * (x - x1) + sine * (y - y1));
 dy := Round(cosinus * (y - y1) - sine * (x - x1));
 len := Round(cosinus * (x2 - x1) + sine * (y2 - y1)); // length of line
 if (dy > -d) and (dy < d) and (dx > -d) and (dx < len + d) then
 Result := True
 else
 Result := False;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
 Canvas.Pen.Width := 1;
 Canvas.MoveTo(0, 0);
 Canvas.LineTo(Width, Weight);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
 p: TPoint;
begin
 GetCursorPos(p);
 p := ScreenToClient(p);
 if CursorOnLinie(p.x, p.y, 0, 0, Width, Height, 1) then
 Caption := 'Mouse on line.'
 else
 Caption := 'Mouse not on line.'
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01602
Проверить, развернут ли или свернут полностью TTreeView

=== Проверить, развернут ли или свернут полностью TTreeView ===
function IsTreeviewFullyExpanded(tv: TTreeview): Boolean;
var
 Node: TTreeNode;
begin
 Assert(Assigned(tv));
 if tv.Items.Count > 0 then
 begin
 Node := tv.Items[0];
 Result := True;
 while Result and Assigned(Node) do
 begin
 Result := Node.Expanded or not Node.HasChildren;
 Node := Node.GetNext;
 end;
 end
 else
 Result := False
end;
function IsTreeviewFullyCollapsed(tv: TTreeview): Boolean;
var
 Node: TTreeNode;
begin
 Assert(Assigned(tv));
 if tv.Items.Count > 0 then
 begin
 Node := tv.Items[0];
 Result := True;
 while Result and Assigned(Node) do
 begin
 Result := not (Node.Expanded and Node.HasChildren);
 Node := Node.GetNext;
 end;
 end
 else
 Result := False
end;
Source: http://delphiworld.narod.ru/
ID: 01123
Проверить запущена ли программа от System account?

=== Проверить запущена ли программа от System account? ===
function OnSystemAccount(): Boolean;
const
 cnMaxNameLen = 254;
var
 sName: string;
 dwNameLen: DWORD;
begin
 dwNameLen := cnMaxNameLen - 1;
 SetLength(sName, cnMaxNameLen);
 GetUserName(PChar(sName), dwNameLen);
 SetLength(sName, dwNameLen);
 if UpperCase(Trim(sName)) = 'SYSTEM' then
 Result := True 
 else 
 Result := False;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01723
Проверить не запущена ли terminal client session?

=== Проверить не запущена ли terminal client session? ===
function IsRemoteSession: Boolean;
const
 sm_RemoteSession = $1000; { from WinUser.h }
begin
 Result := (GetSystemMetrics(sm_RemoteSession) <> 0);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02238
Проверить файл базы данных на возможность открытия в монопольном режиме

=== Проверить файл базы данных на возможность открытия в монопольном режиме ===
function ApplicationUse(AName: string ) : boolean;
// проверка на занятость файла
var
 HFileRes: HFILE;
begin
 Result := False;
 if not FileExists(AName) then Exit;
 HFileRes := CreateFile(PChar(AName), GENERIC_READ or GENERIC_WRITE, 0, nil,
 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
 Result := (HFileRes = INVALID_HANDLE_VALUE);
 if not Result then CloseHandle(HFileRes);
end;
Source: Взято из http://forum.sources.ru
ID: 02768
Проверка значения бита

=== Проверка значения бита ===
Проверка - установлен ли определенный бит?
function IsBitSet(Value: Cardinal; BitNum: Byte): Boolean;
begin
 Result := ((Value shr BitNum) and 1) = 1;
end;
// Пример использования
if IsBitSet(43691, 1) then // установлен (равен 1)
Source: Взято из http://forum.sources.ru
ID: 00226
----
function GetBitStat(SetWord, BitNum: Word): Boolean;
begin
 GetBitStat := SetWord and BitNum = BitNum { Если бит установлен }
end;
Source: http://delphiworld.narod.ru
ID: 00818
----
unit BitsForm;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls, StdCtrls;
type
 TForm1 = class(TForm)
 Label1: TLabel;
 GroupBox1: TGroupBox;
 CheckBox1: TCheckBox;
 CheckBox2: TCheckBox;
 CheckBox3: TCheckBox;
 CheckBox4: TCheckBox;
 CheckBox5: TCheckBox;
 Edit1: TEdit;
 UpDown1: TUpDown;
 procedure Edit1Change(Sender: TObject);
 procedure CheckBoxClick(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
function IsBitOn (Value: Integer; Bit: Byte): Boolean;
begin
 Result := (Value and (1 shl Bit)) <> 0;
end;
function TurnBitOn (Value: Integer; Bit: Byte): Integer;
begin
 Result := Value or (1 shl Bit);
end;
function TurnBitOff (Value: Integer; Bit: Byte): Integer;
begin
 Result := Value and not (1 shl Bit);
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
 I: Integer;
 CheckBox: TCheckBox;
begin
 for I := 1 to 5 do
 begin
 Checkbox := FindComponent (
 'Checkbox' + IntToStr (I)) as TCheckbox;
 CheckBox.Checked :=
 IsBitOn (UpDown1.Position, CheckBox.Tag);
 end;
end;
procedure TForm1.CheckBoxClick(Sender: TObject);
var
 Val: Integer;
begin
 Val := UpDown1.Position;
 with Sender as TCheckBox do
 if Checked then
 Val := TurnBitOn (Val, Tag)
 else
 Val := TurnBitOff (Val, Tag);
 UpDown1.Position := Val;
end;
end.
Source: http://delphiworld.narod.ru
ID: 00830
----
unit BitsForm;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ComCtrls, StdCtrls;
type
 TForm1 = class(TForm)
 Label1: TLabel;
 GroupBox1: TGroupBox;
 CheckBox1: TCheckBox;
 CheckBox2: TCheckBox;
 CheckBox3: TCheckBox;
 CheckBox4: TCheckBox;
 CheckBox5: TCheckBox;
 Edit1: TEdit;
 procedure CheckBoxClick(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 procedure FormDestroy(Sender: TObject);
 private
 MyBits: TBits;
 procedure UpdateEdit;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
uses
 Math;
procedure TForm1.UpdateEdit;
var
 I, Total: Integer;
begin
 Total := 0;
 for I := 0 to 4 do
 if MyBits.Bits [I] then
 Total := Total + Round (Power (2, I));
 Edit1.Text := IntToStr (Total);
end;
procedure TForm1.CheckBoxClick(Sender: TObject);
begin
 MyBits.Bits [(Sender as TCheckBox).Tag] :=
 not MyBits.Bits [(Sender as TCheckBox).Tag];
 UpdateEdit;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 MyBits := TBits.Create;
 MyBits.Size := 5;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 MyBits.Free;
end;
end.
Source: http://delphiworld.narod.ru
ID: 00831