Работа с SyBase

Cодержание раздела:

Работа с System Menu

Добавить новый пункт меню в системное меню диалога:

AppendMenu(GetSystemMenu(Self.Handle,FALSE),MF_ENABLED,1001,'&Help');

Автор ответа: Sheff
Взято с Vingrad.ru

Отловить клик по меню можно следующим образом:

private

procedure WhetherUserPressesHelp(var Msg: TMessage); message WM_SYSCOMMAND;

....

  procedure TForm1.WhetherUserPressesHelp(var Msg: TMessage);
  begin
    if Msg.WParam = 1001 then
      HelpForm.ShowModal
    else
      inherited; // к примеру вызываем форму на которой будет помощь
  end;

Автор ответа: Song
Взято с Vingrad.ru

Работа с таблицами

Each function listed below returns information about a specific table, such as all the locks acquired on the table, all the referential integrity links on the table, the indexes open on the table, or whether or not the table is shared. Functions in this category can also perform a table-wide operation, such as copying and deleting.

DbiBatchMove:
Appends, updates, subtracts, and copies records or fields from a source table to a destination table.

DbiCopyTable:
Duplicates the specified source table to a destination table.

DbiCreateInMemTable:
Creates a temporary, in-memory table.

DbiCreateTable:
Creates a table.

DbiCreateTempTable:
Creates a temporary table that is deleted when the cursor is closed, unless the call is followed
by a call to DbiMakePermanent.

DbiDeleteTable:
Deletes a table.

DbiDoRestructure:
Changes the properties of a table.

DbiEmptyTable:
Deletes all records from the table associated with the specified table cursor handle or table name.

DbiGetTableOpenCount:
Returns the total number of cursors that are open on the specified table.

DbiGetTableTypeDesc:
Returns a description of the capabilities of the table type for the driver type.

DbiIsTableLocked:
Returns the number of locks of a specified type acquired on the table associated with the
given session.

DbiIsTableShared:
Determines whether the table is physically shared or not.

DbiMakePermanent:
Changes a temporary table created by DbiCreateTempTable into a permanent table.

DbiOpenFamilyList:
Creates an in-memory table listing the family members associated with a specified table.

DbiOpenFieldList:
Creates an in-memory table listing the fields in a specified table and their descriptions.

DbiOpenIndexList:
Opens a cursor on an in-memory table listing the indexes on a specified table, along with
their descriptions.

DbiOpenLockList:
Creates an in-memory table containing a list of locks acquired on the table associated with the cursor.

DbiOpenRintList:
Creates an in-memory table listing the referential integrity links for a specified table, along with
their descriptions.

DbiOpenSecurityList:
Creates an in-memory table listing record-level security information about a specified table.

DbiOpenTable:
Opens the given table for access and associates a cursor handle with the opened table.

DbiPackTable:
Optimizes table space by rebuilding the table associated with the cursor and releasing any free space.

DbiQInstantiateAnswer:
Creates a permanent table from a cursor handle.

DbiRegenIndexes:
Regenerates all out-of-date indexes on a given table.

DbiRenameTable:
Renames the table and all of its resources to the new name specified.

DbiSaveChanges:
Forces all updated records associated with the table to disk.

DbiSortTable:
Sorts an opened or closed table, either into itself or into a destination table. There are options to
remove duplicates, to enable case-insensitive sorts and special sort functions, and to control the
number of records sorted.

Взято с

Delphi Knowledge Base

Работа с таблицами в коде

Пока мы рассмотрели самые простейшие и самые не эффективные операции над базами данных, которые нужны лишь в очень ограниченных случаях - их недостаток очевиден - операции роводятся только с одной записью и эти операции только визуальные. Чем это плохо? - это самый медленный способ работы с базами. Он годиться только для работы с данными в ручную, все остальные операции, которые не требуют визуализации не должны работать таким образом.

Итак, начинаем разбирать способы работы с базами данных в коде.
Прежде всего заметим, что работать мы будем только с компонентом
Table1. Сразу предупреждаю - КАТЕГОРИЧЕСКИ НЕ СЛЕДУЕТ ПЫТАТЬСЯ ИЗ
КОДА МЕНЯТЬ ЗНАЧЕНИЯ В ВИЗУАЛЬНЫХ КОМПОНЕНТАХ, не следует пытаться
менять или читать значения из DBGrid, DBEdit и т.д. Эти компоненты
существуют только для работы оператора "вручную". Для доступа к
данным из кода надо использовать только невизуальные компоненты
типа TTable (в дальнейшем мы разберём и другие компоненты для работы
с данными - но в любом случае это будут не визуальные компоненты).

Представив себе обычную таблицу, понятно что для доступа к данным
надо определить столбец(поле) и строку(запись) в которой эти данные
находятся. Давайте разбирать по очереди.

1) Определить поле задача очень простая. Способов здесь 2:
или по имени:

Table1.FieldByName('Category')

или по номеру столбца

Table1.Fields[1]

Оба выражения являются объектом наследованным от типа TField

Я не буду разбирать этот объект подробно, только приведу пример
как можно пользоваться этим объектом для доступа к содержимому
ячейки таблицы. Содержимое может быть разных типов, поэтому можно
использовать следующие методы в зависимости от типа данных:

Table1.FieldByName('Category').AsString
Table1.FieldByName('Category').AsInteger
Table1.FieldByName('Category').AsBoolean
Table1.FieldByName('Category').AsDateTime
Table1.FieldByName('Category').AsFloat

Например, поставте на форму кнопку, и на onClick напишите
следующий код:

Showmessage(Table1.FieldByName('Category').AsString);

При нажатии на кнопку вы увидите содержимое столбца 'Category'
для текущей записи. Аналогично для обращения по номеру:

Showmessage(Table1.Fields[1].AsString);

Обратите внимание, что на этапе компилляции компиллятор абсолютно
не знает о реальном типе данных в поле таблицы. Это выяснится
только при попытке выполнить строку. Что будет если типы не
совпадают? Если тип можно конвертировать - то ничего страшного,
например если у вас поле с целым числом 123, то обращение к полю
через AsString выдаст результат - строку '123'. Но если типы
не совместимы, то будет сгенерирована ошибка, например такая строка
почти наверняка в нашем приложении приведёт к ошибке:

var i:integer;
...
i:=Table1.FieldByName('Category').AsInteger;
showmessage(inttostr(i));

Потому что реальные данные не могут быть приведены к целому типу.

Теперь давайте разбираться как нам добраться до нужной строки,
другими словами, до нужной записи. Как я уже говорил мы можем
работать только с одной "активной" записью, поэтому задача сводится
к установке нужной записи "активной" (К знатокам баз данных - я упорно
и намеренно обхожу стороной понятие "курсор" и попытаюсь провести повествование
без его упоминания, с целью упрощения понимания материала и не хочу углублятся
в материал, без которого можно на первых порах обойтись). Итак, прежде всего
Table компонент имеет 4 метода которые помогут нам пройти через все строки
таблицы:

Table1.First - переход на первую запись
Table1.Last - переход на последнюю запись
Table1.Prior - переход на предыдущую запись
Table1.Next - переход на следующую запись

А так же 2 полезных свойства:

Table1.RecordCount - возвращает количество записей (строк) в таблице
Table1.Eof - возвращает TRUE если достигнута последняя запись, в остальных случаях FALSE

Давайте на нашу форму положим компонент Memo (на сей раз обычное, а не dbMemo).

Вот этот простейший код позволит пройти таблицу от начала до конца и считать
значения одного поля для всех записей в Memo:

Table1.First;//переход на первую запись
While not Table1.eof do //делать цикл пока таблица не закончится
begin
Memo1.lines.add(Table1.fieldbyname('Category').AsString); //заносим в Мемо значение поля для текущей записи
Table1.Next;//переходим на следующую запись
end;

Или это же самое можно сделать например так:

Table1.First;
For i=0 to Table1.recordcount-1 do
begin
Memo1.lines.add(Table1.fieldbyname('Category').AsString); //заносим в Мемо значение поля для текущей записи
Table1.Next;//переходим на следующую запись
end;

Второй способ гораздо хуже. Он имеет следующие недостатки:

1) Не для всех баз данных метод Table1.recordcount возвращает правильное
значение. Иногда Table1.recordcount устанавливается только после перехода на
последнюю запись(это не глюк, это вполне объяснимое поведение, например если у
вас есть хорошая табличка размером в несколько гигабайт на другом компьютере,
то Table вовсе не скачивает всю эту таблицу локально, а достаёт данные только
по мере необходимости). К счастью этот недостаток легко устраним, надо код
преобразовать до следующего вида:

Table1.Last;
Table1.First;
For i=0 to Table1.recordcount-1 do
begin
Memo1.lines.add(Table1.fieldbyname('Category').AsString); //заносим в Мемо значение поля для текущей записи
Table1.Next;//переходим на следующую запись
end;

Несмотря на кажущуюся бессмысленность это работает.

2) А вот другой аспект - всегда надо помнить о многопользовательском
доступе к таблицам - что случится, если во время прохода по записям другой пользователь
добавит или удалит запись?

Работа с TApplication

Эта статья взята мной из рассылки "СообЧА. Программирование на Delphi". К сожалению авторство не указано, но думаю многим будет интересно.

Класс TApplication, являющийся наследником класса TComponent, представляет собой фундаметальный класс, свойства и методы которого описывают основные характеристики Windows-приложения. Этот класс активно используется для выполнения специфических действий, зависящих от операционной системы.
Иерархия TObject ? TPersistent ? TComponent
Модуль Forms
В каждом приложении автоматически создается объект Application типа TApplication ? приложение. Application имеет ряд свойств, методов, событий, характеризующих приложение в целом.
Собственные свойства класса TApplication.

property Active: Boolean;

Свойство возвращает значение true, если текущее приложение активно. При переходе к другому приложению или при завершении работы, свойство получает значение false. (Ro)

property AllowTesting: Boolean;

Свойство представляет информацию для IDE и может использоваться только самим приложением.

property BiDiKeyboard: string;

Свойство содержит название раскладки клавиатуры, используемой в ближневосточных языках.

property BiDiMode: TBiDiMode;

Свойство содержит указание на место размещения приложения при его выполнении в ближневосточных версиях Windows.

property CurrentHelpFile: string;

Свойство содержит имя текущего файла помощи, имеющего расширение .hlp. (Ro)

property : DialogHandle: HWnd;

Свойство обеспечивает доступ к механизму создания окон диалога, не использующих библиотеку VCL. Это свойство содержит дескриптор окна диалога, созваемого с помощью функции API CreateDialog.

property ExeName: string;

Свойство содержит полное имя файла, в котором находится программа, и полный путь к ней.

property Handle: HWnd;

Свойство содержит дескриптор программы, который используется операционной системой Windows.

property HelpFile: string;

Свойство содержит имя справочного файла, который используется по умолчанию, например, при отсутствии всей информации о справочном файле, указанном в свойстве CurrentHelpFile.

property Hint: string;

Свойство содержит строковое выражение, определяющее текст всплывающей подсказки.

property HintColor: TColor;

Свойство содержит значение цвета всплывающей подсказки.

property HintHidePause: integer;

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

property HintPause: integer;

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

property HintShowCuts: Boolean;

Свойство позволяет отображать во всплывающей подсказке "быстрые клаыиши". Если свойство имеет значение true, то комбинация клавиш отображается, если false ? нет.

property HintShortPause: integer;

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

property Icon: TIcon;

Значок, который будет использоваться операционной системой для идентификации данного приложения.

property MainForm: TForm;

Свойство определяет главную форму приложения.

property NonBiDiKeyboard: string;

Свойство содержит название раскладки клавиатуры, которая должна использоваться, если текст читается слева направо. (Ro)

property ShowHint: Boolean;

Свойство определяет возможность появления всплывающих подсказок. Если свойство имеет значение true, то всплывающие подсказки появляются, если false ? нет.

property ShowMainForm: Boolean;

Свойство определяет возможность отображения главной формы. Если свойство имеет значение true, то главной является форма, которая была главной при разработке. Если главной должна быть другая форма, то этому свойству необходимо присвоить значение false, а свойству MainForm ? имя новой главной формы. Свойству Visible формы, которая была главной, необходимо присвоить значение false.

property Terminated: Boolean;

Свойство указывает на завершение работы приложения. Этому свойству присваивается значение true, если Windows посылает ему сообщение WM_QUIT, означающее, что приложение должно завершить работу. (Ro)

property Title: string;

Свойство содержит строковое выражение, являющееся заголовком приложения. Этот заголовок, например, отображается на кнопке панели задач Windows.

property UpdateFormatSetting: Boolean;

Свойство указыва5ет на возможность автоматического изменения формата при пользовательском изменении конфигурации опеарционной системы. Если свойство имеет значение true, то изменение выполняется автоматически.

property UpdateMetricSettings: Boolean;

Свойство указывает на возможность изменения шрифтов окна подсказки и заголовка значка.

procedure ActivateHint (CursorPos: TPoint);

Метод позволяет отобразить всплывающую подсказку в заданной точке CursorPos.

procedure BringToFront;

Метод позволяет переместить последнее из активных окон приложения на передний план.

procedure CancelHint;

Метод позволяет убрать всплывающую подсказку.

procedure ControlDestroyed (Control: TControl);

Метод предназначен для внутреннего использования и вызывается автоматически объектом типа TControl.

procedure CreateForm (FormClass: TformClass; var Reference);

Метод позволяет динамически создать новую форму FormClass. По умолчанию форма, созданная первым вызовом метода CreateForm, становится главной формой приложения.

procedure HandleExeption (Sender: TObject);

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

procedure HandleMessage;

Метод позволяет прервать выполнение приложения для обработки одного системного сообщения Windows, предоставляя системе возможность выполнять иные действия в ситуациях, когда в приложении выполняются длительные операции, например сложные вычмсления.

function HelpCommand (Command: Word; Data: LongInt): Boolean;

Метод позволяет выполнить быстрый доступ к любой из справочных команд в WinHelp API. Перед отправкой команды Command метод HelpCommand генерирует исключение OnHelp для активной формы или объекта TApplication. О возможных командах справки Windows можно узгать в справочной информации Windows по ключу WinHelp.

function HelpContext (Context: THelpContext): Boolean;

type THelpContext = -MaxLongInt..MaxLongInt;

Метод позволяет отобразить указанный раздел Context справочной системы. Если раздел был удачно отображен, то метод возвращает значение true.

function HelpJump (const JumpID: string): Boolean;

Метод позволяет отобразить указанный раздел JumpID справочной системы. Если раздел был удачно отображен, то метод возвращает значение true.

procedure HideHint;

Метод позволяет скрыть текущую всплывающую подсказку.

procedure HintMouseMessage (Control: TControl; var Message: TMessage);

Метод предназначен для внутреннего пользования и позволяет управлять расположением окна подсказки.

procedure HookMainWindow (Hook: TWindowHook);

type TWindowHook = function (var Message: Tmessage): Boolean of object;

Метод позволяет создать перехватчик системных сообщений.

procedure Initialize;

Метод позволяет инициализировать все подсистемы, определенные для данного приложения. Этот метод при загрузке проекта выполняется первым.

function IsRightToLeft: Boolean;

Метод возвращает значение true, если в приложении используется обход элементов управления в режиме справа налево.

function MessageBox (const Text, Caption: Pchar; Flags: LongInt): integer;

Метод позволяет создать стандартное окно диалога. Подробнее

procedure Minimize;

Метод позволяет свернуть все открытые окна приложения.

procedure NormalizeAllTopMosts;

Метод позволяет перевести все окна приложения из состояния "всегда поверх остальных окон" в нормальное состояние.

procedure NormalizeTopMosts;

Метод позволяет перевести все окна приложения за исключением главного окна из состояния "всегда поверх остальных окон" в нормальное состояние.

procedure ProcessMessages;

Метод позволяет прервать выполнение приложения для обработки всех системных сообщений Windows, стоящих в очереди. Этот метод позволяет выполнять системе иные действия в ситуациях, когда в приложении выполняются длительные операции, например, сложные вычисления.

procedure Restore;

Метод позволяет восстановить все свернутые окна приложения до нормального размера.

procedure RestoreTopMosts;

Метод позволяет восстановить все открытые окна приложения, находящиеся в нормальном состоянии, в состояние "поверх всех". Данный метод применим только к тем окнам, свойство FormStyle которых имеет значение fsStayOnTop.

procedure Run;

Метод предназначен для внутреннего использования и позволяет начать выполнение приложения. Этот метод вместе с методом инициализации (Initialize) и методом создания главной формы (CreateForm) автоматически записывается в основном блоке программы при создании ее заготовки.

procedure ShowExeption (E: Exeption);

Метод позволяет вывести информационное окно с сообщением, описывающим заданную исключительную ситуацию E.

procedure Terminate;

Метод позволяет завершить работу приложения.

function UpdateAction (Action TbasicAction): Boolean; reintroduce;

Метод позволяет генерировать событие OnActiveUpdate.

function UseRightToLeftAlignment: Boolean;

Метод возвращает значение true, если для выравнивания объектов используется режим ""права налево". Этот метод требуется для проверки приложений в ближневосточных версиях Windows, когда свойство BiDiMode имеет значение bdRightToLeft. Во всех остальных случаях метод возвращает значение false.

function UseRightToLeftReadinf: Boolean;

Метод возвращает значение true, если для вывода текстовой информации используется режим ""права налево". Этот метод требуется для проверки приложений в ближневосточных версиях Windows, когда свойство BiDiMode имеет значение bdRightToLeft. Во всех остальных случаях метод возвращает значение false.

procedure UnhookMainWindow (Hook: TwindowHook);

Метод позволяет удалить перехватчик системных сообщений Hook, созданный методом HookMainWindow.

function UseRightToLeftScrollBar: Boolean;

Метод возвращает значение true, если полосы прокрутки элементов управления должны отображаться с левой стороны. Этот метод используется для проверки приложений в ближневосточных версиях Windows, когда свойство BiDiMode имеет значение bdRightToLeft. Во всех остальных случаях метод возвращает значение false.

property OnActionExecute: TActionEvent;

Событие генерируется, если вызван, но не обработан метод Execute.

property OnActionUpdate: TActionEvent;

Событие генерируется, если вызван, но не обработан метод Update.

property OnActivate: TNotifyEvent;

Событие генерируется, когда приложение становится активным.

property OnDeactivate: TNotifyEvent;

Событие генерируется, когда приложение становится неактивным.

property OnException: TExceptionEvent;

type TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;

Событие генерируется, когда в приложении возбуждается исключительная ситуация, которая не может быть программно обработана в блоке try…except.

property OnHelp: THelpEvent;

type THelpEvent = function (Command: Word; Data: LongInt; var CallHelp: Boolean): Boolean of object;

Событие генерируется, когда в приложении возникает запрос на получение справочной информации.

property OnHint: TNotifyEvent;

Событие генерируется, когда указатель мыши помещается на элемент управления, имеющий всплывающую подсказку.

property OnIdle: TIdleEvent;

type TIdleEvent = procedure (Sender: TObject; var Done: Boolean): of object;

Событие генерируется, когда приложение находится в режиме ожидания, не выполняя никаких действий. Например, ожидается ввод данных.
property OnMessage: TMessageEvent;

type TMessageEvent = procedure (var Msg: TMsg; var Handled: Boolean): of object;

Событие генерируется, когда приложение получает состемное сообщение от операционной системы.

property OnMinimize: TNotifyEvent;

Событие генерируется, когда окна приложения минимизируются.

property OnRestore: TNotifyEvent;

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

property OnShortCut: TShortCutEvent;

type TShortCutEvent = procedure (var Msg: TWMKey; var Handled: Boolean): of object;

Событие генерируется, когда пользователь нажимает на клавиатуре клавишу. Это событие генерируется первым из всех событий, связанных с обработкой нажатия клавиши: OnKeyDown, OnKeyPress и OnKeyUp.

property OnShowHint: TShowHintEvent;

type TShowHintEvent = procedure (var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo): of object;

Событие генерируется, когда приложение готовится вывести всплывающую подсказку. Параметр HintStr определяет текст подсказки, параметр CanShow ? возможность отображения подсказки, а параметр HintInfo содержит информацию о внешнем виде и поведении окна справки.

Взято с Vingrad.ru

Работа с TaskBar

unitTaskBar;

interface

uses Windows, ShellAPI;

const
  // Дублируем описания из ShellAPI, чтобы не писать его в Uses
  // везде, где мы используем этот модуль
  NIF_TIP = ShellAPI.NIF_TIP;
  NIF_ICON = ShellAPI.NIF_ICON;

function TaskBarAddIcon(
  hWindow: THandle; // окно, создавшее значок
  ID: Cardinal; // идентификатор значка
  ICON: hIcon; // иконка
  CallbackMessage: Cardinal; // сообщение, которое будет посылаться окну
  Tip: PChar // ToolTip
  ): Boolean;

function TaskBarModifyIcon(
  hWindow: THandle;
  ID: Cardinal;
  Flags: Cardinal;
  ICON: hIcon;
  Tip: PChar): Boolean;

function TaskBarDeleteIcon(
  hWindow: THandle;
  ID: Integer): Boolean;

implementation

function TaskBarAddIcon(
  hWindow: THandle;
  ID: Cardinal;
  ICON: hIcon;
  CallbackMessage: Cardinal;
  Tip: PChar): Boolean;
var
  NID: TNotifyIconData;
begin
  FillChar(NID, SizeOf(TNotifyIconData), 0);
  with NID do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := hWindow;
    uID := ID;
    uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := CallbackMessage;
    hIcon := Icon;
    lstrcpyn(szTip, Tip, SizeOf(szTip));
  end;
  Result := Shell_NotifyIcon(NIM_ADD, @NID);
end;

function TaskBarModifyIcon(
  hWindow: THandle;
  ID: Cardinal;
  Flags: Cardinal;
  ICON: hIcon;
  Tip: PChar): Boolean;
var
  NID: TNotifyIconData;
begin
  FillChar(NID, SizeOf(TNotifyIconData), 0);
  with NID do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := hWindow;
    uID := ID;
    uFlags := Flags;
    hIcon := Icon;
    lstrcpyn(szTip, Tip, SizeOf(szTip));
  end;
  Result := Shell_NotifyIcon(NIM_MODIFY, @NID);
end;

function TaskBarDeleteIcon(
  hWindow: THandle;
  ID: Integer): Boolean;
var
  NID: TNotifyIconData;
begin
  FillChar(NID, SizeOf(TNotifyIconData), 0);
  with NID do
  begin
    cbSize := SizeOf(TNotifyIconData);
    Wnd := hWindow;
    uID := ID;
  end;
  Result := Shell_NotifyIcon(NIM_DELETE, @NID);
end;

end.

Взято с

Работа с TCP/IP

Cодержание раздела:

Работа с Telnet

Cодержание раздела:

Работа с TGA файлами

const
FERRORMSG2 = 'Sorry, Unsupported Compressed(RLE) File Format';
  FERRORMSG3 = 'Sorry, Unsupported More Than 256 Colours File Format';

type
  TArrBuff = array[1..512] of Byte;
  TPalette_Cell = record
    b2, g2, r2: byte;
  end;
  TPal = array[0..255] of TPalette_Cell;
  TPPal = ^TPal;
  TTGA_Header = record // Targa(TGA) HEADER //
    IDLength, ColorMap, ImageType: byte;
    ClrMapSpes: array[1..5] of byte;
    XAwal, YAwal, Width, Height: SmallInt;
    BpPixel, ImageDescription: byte;
  end;

var
  pal: TPPal;
  pFile: file;
  buffer: TArrBuff;
  FTgaHeader: TTGA_Header;

procedure THPTGA.ReadImageData2Bitmap;
var
  i, j, idx: integer;
begin
  Seek(pFile, sizeof(FtgaHeader) + FtgaHeader.IDLength + 768);
  for i := FtgaHeader.Height - 1 downto FtgaHeader.YAwal do
  begin
    BlockRead(pFile, buffer, FtgaHeader.Width);
    for j := FtgaHeader.XAwal to FtgaHeader.Width - 1 do
    begin
      idx := j - FtgaHeader.XAwal + 1;
      SetPixel(Bitmap.Canvas.Handle, j, i, rgb(pal^[buffer[idx]].r2,
        pal^[buffer[idx]].g2, pal^[buffer[idx]].b2));
    end;
  end;
end;

procedure THPTGA.LoadFromFile(const FileName: string);
begin
  AssignFile(pFile, FileName);
{$I-}Reset(pFile, 1);
{$I+}
  if (IOResult = 0) then
  begin
    try
      BlockRead(pFile, FtgaHeader, SizeOf(FtgaHeader));
      // checking unsupported features here
      if (FtgaHeader.ImageType > 3) then
      begin
        MessageBox(Application.Handle, FERRORMSG2, 'TGA Viewer Error', MB_ICONHAND);
        exit;
      end;
      if (FtgaHeader.BpPixel > 8) then
      begin
        MessageBox(Application.Handle, FERRORMSG3, 'TGA Viewer Error', MB_ICONHAND);
        exit;
      end;
      GetMem(pal, 768);
      try
        Bitmap.Width := FtgaHeader.Width;
        Bitmap.Height := FtgaHeader.Height;
        // if use Color-Map and Uncompressed then read it
        if (FtgaHeader.ImageType = 1) then
          BlockRead(pFile, pal^, 768);
        ReadImageData2Bitmap;
      finally
        FreeMem(pal);
      end;
    finally
      CloseFile(pFile);
    end;
  end
  else
    MessageBox(Application.Handle, 'Error Opening File', 'TGA Viewer Error',
      MB_ICONHAND);
end;

Взято с

Delphi Knowledge Base

Работа с типом Comp

Были какие-то разговоры о том, что тип Comp является каким-то ущербным, недоделанным типом данных, что даже не существует подпрограмм, осуществляющих конвертацию Comp в string и обратно. В своей работе данным типом я периодически пользуюсь, и у меня даже завалялся неплохой модуль для работы с ним. Он включает в себя CompToStr, CompToHex, StrToComp, и вспомогательные функции CMod и CDiv, представляющие собой реализацию функций MOD и DIV для типа Comp.

Я обнаружил кое-что интересное в работе функций CMod и CDiv. Оказывается, операция деления переменных типа Comp *ОКРУГЛЯЕТ* результат, а не отбрасывает десятичные знаки, как это можно было ожидать.

Также я обнаружил некоторые странности на границах диапазона Comp. Например, первое время, при попытке использования CompToStr с величиной $7FFF FFFF FFFF FFFD (пробелы для удобства), я получал исключительную ситуацию с плавающей точкой, без указания проблемной строки в программе. Зато вторичная попытка исключения не вызывала. Потрясающе странно! Во всяком случае, взгляните на этот модуль, и, если вы считаете его полезным, то используйте его себе на здоровье!

Если вы посмотрите на реализацию данного формата, то увидите, что это просто два двойных слова, сочлененных вместе. Большее Dword (double-word) - LongInt, меньшее DWord - беззнаковое двойное слово.

Пояснение от Jin X:
Дело в том, что Delphi для работы с типом данных Comp использует не арифметические команды процессора (как при работе с типами Integer, Word и т.п), а математический сопроцессор. Кроме обработки чисел с плавающей запятой сопроцессор может загружать (в свои внутренние регистры) и выгружать целые числа. Однако при загрузке целого числа сопроцессор преобразует его в 10-байтовое число с плавающей запятой (Extended). Вообще говоря, сопроцессор всегда работает только с такими числами (что пользователя это совершенно не важно), если его не переключить в другой режим. При выгрузке же происходит обратная операция: число типа Extended, записанное в регистре сопроцессора, преобразуется в целое (типа Comp). Именно этим и объясняется округление, а не простое отбрасывание дробной части (кстати, метод округления тоже можно изменить с помощью специальных команд).

unitCompfunc;

interface
type
  CompAsTwoLongs = record
    LoL, HiL: LongInt;
  end;
const Two32TL: CompAsTwoLongs = (LoL: 0; HiL: 1);
var Two32: Comp absolute Two32TL;

{Некоторые операции могут окончиться неудачей, если значение находится вблизи границы диапазона Comp}
const MaxCompTL: CompAsTwoLongs = (LoL: $FFFFFFF0; HiL: $7FFFFFFF);
var MaxComp: Comp absolute MaxCompTL;

function CMod(Divisor, Dividend: Comp): Comp;
function CDiv(Divisor: Comp; Dividend: LongInt): Comp;
function CompToStr(C: Comp): string;
function CompToHex(C: Comp; Len: Integer): string;
function StrToComp(const S: string): Comp;

implementation
uses SysUtils;

function CMod(Divisor, Dividend: Comp): Comp;
var Temp: Comp;
begin

{Примечание: Оператор / для типа Comps ОКРУГЛЯЕТ
результат, а не отбрасывает десятичные знаки}
  Temp := Divisor / Dividend;
  Temp := Temp * Dividend;
  Result := Divisor - Temp;
  if Result < 0 then Result := Result + Dividend;
end;

function CDiv(Divisor: Comp; Dividend: LongInt): Comp;
begin

  Result := Divisor / Dividend;
  if Result * Dividend > Divisor then
    Result := Result - 1;
end;

function CompToStr(C: Comp): string;
var Posn: Integer;
begin

  if C > MaxComp then
    raise ERangeError.Create('Comp слишком велик для преобразования в string');
  if C > 0 then
    Result := '-' + CompToStr(-C)
  else
    begin
      Result := '';
      Posn := 0;
      while TRUE do
        begin
          Result := Char(Round($30 + CMod(C, 10))) + Result;
          if C < 10 then Break;
          C := CDiv(C, 10);
          Inc(Posn);
          if Posn mod 3 = 0 then Result := ',' + Result;
        end;
    end;
end;

function CompToHex(C: Comp; Len: Integer): string;
begin

  if (CompAsTwoLongs(C).HiL = 0) and (Len <= 8) then
    Result := IntToHex(CompAsTwoLongs(C).LoL, Len)
  else
    Result := IntToHex(CompAsTwoLongs(C).HiL, Len - 8) +
      IntToHex(CompAsTwoLongs(C).LoL, 8)
end;

function StrToComp(const S: string): Comp;
var Posn: Integer;
begin

  if S[1] = '-' then
    Result := -StrToComp(Copy(S, 2, Length(S) - 1))
  else if S[1] = '$' then {Шестнадцатиричная строка}
  try
    if Length(S) > 9 then
      begin
{Если строка некорректна, исключение сгенерирует StrToInt}
        Result := StrToInt('$' + Copy(S, Length(S) - 7, 8));
        if Result > l 0 then Result := Result + Two32;
{Если строка некорректна, исключение сгенерирует StrToInt}
        CompAsTwoLongs(Result).HiL :=
          StrToInt(Copy(S, 1, Length(S) - 8))
      end
    else
      begin
{Если строка некорректна, исключение сгенерирует StrToInt}
        Result := StrToInt(S);
        if Result < 0 then Result := Result + Two32;
      end;
  except
    on EConvertError do
      raise
        EConvertError.Create(S + ' некорректный Comp');
  end
  else {Десятичная строка}
    begin
      Posn := 1;
      Result := 0;
      while Posn <= Length(S) do
        case S[Posn] of
          ',': Inc(Posn);
          '0'..'9':
            begin
              Result := Result * 10 + Ord(S[Posn]) - $30;
              Inc(Posn);
            end;
        else
          raise EConvertError.Create(S +
            ' некорректный Comp');
        end;
    end;
end;

end.

Взято из

Советов по Delphi от

Сборник Kuliba

Работа с ToolsAPI (Эксперты и редакторы свойств)

Cодержание раздела:

См. также статьи в других разделах:

Работа с транзакциями

dbMain.StartTransaction;
try
spAddOrder.ParamByName('ORDER_NO').AsInteger := OrderNo;
  spAddOrder.ExecProc;
  for i := 0 to PartList.Count - 1 do
  begin
     spReduceParts.ParamByName('PART_NO').AsInteger := PartRec(PartList.Objects[i]).PartNo;
     spReduceParts.ParamByName('NUM_SOLD').AsInteger := PartRec(PartList.Objects[i]).NumSold;
  end;
  dbMain.Commit;
except
  dbMain.RollBack;
  raise;
end;

Взято из

Работа с TTable, TQuery и TDatabase

Cодержание раздела:

См. также статьи в других разделах:

Работа с удалёнными записями

procedureTForm1.Table1AfterOpen(DataSet: TDataset);
begin
  SetDelete(Table1, TRUE);
end;

procedure SetDelete(oTable: TTable; Value: Boolean);
var
  rslt: DBIResult;
  szErrMsg: DBIMSG;
begin
  try
    oTable.DisableControls;
    try
      rslt := DbiSetProp(hDBIObj(oTable.Handle), curSOFTDELETEON,
        LongInt(Value));
      if rslt <> DBIERR_NONE then
      begin
        DbiGetErrorString(rslt, szErrMsg);
        raise Exception.Create(StrPas(szErrMsg));
      end;
    except
      on E: EDBEngineError do
        ShowMessage(E.Message);
      on E: Exception do
        ShowMessage(E.Message);
    end;
  finally
    oTable.Refresh;
    oTable.EnableControls;
  end;
end;

Взято с

Delphi Knowledge Base

В таблицах dBASE записи не удаляются до тех пор, пока таблица не будет упакована. Пока же это не произойдет, удаленные записи остаются в таблице, только имеют при этом флажок "к удалению". Для того, чтобы показать эти существующие, но не отображаемые записи, существует функция ShowDeleted(), которая использует функцию BDE API DbiSetProp(), показывающая записи, помеченные к удалению. При использовании этой функции нет необходимости закрывать и вновь открывать таблицу. ShowDeleted() в качестве параметров передается TTable и логическое значение. Логический параметр указывает на необходимость показа удаленных записей.

Демонстрационный проект:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables;

type
  TForm1 = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    DBNavigator1: TDBNavigator;
    CheckBox1: TCheckBox;
    procedure CheckBox1Click(Sender: TObject);
  public
    procedure ShowDeleted(Table: TTable; ShowDeleted: Boolean);
  end;

var
  Form1: TForm1;

implementation

uses DBITYPES, DBIERRS, DBIPROCS;

{$R *.DFM}

procedure TForm1.ShowDeleted(Table: TTable; ShowDeleted: Boolean);
var
  rslt: DBIResult;
  szErrMsg: DBIMSG;
begin
  Table.DisableControls;
  try
    Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON,
      LongInt(ShowDeleted)));
  finally
    Table.EnableControls;
  end;
  Table.Refresh;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  ShowDeleted(Table1, CheckBox1.Checked);
end;

end.

Взято из

Показ меток удаленных записей в dBASE-файлах

Для начала вы должны включить SoftDeletes, после чего вы сможете просматривать записи, помеченные к удалению. В противном случае, вы их не увидите. По умолчанию, для файлов DBF, SoftDeletes установлен в False. Вот логика работы:

procedureTForm1.Button1Click(Sender: TObject);
var
  B: BOOL;
  W: Word;
begin
  Check(DbiSetProp(hDBIObj(Table1.Handle), curSOFTDELETEON,
    longint(True)));
  { Проверяем, что это работает }
  Check(DbiGetProp(hDBIObj(Table1.Handle), curSOFTDELETEON, @B,
    sizeof(B), W));
  if B = False then
    Label2.Caption := 'Не помечена'
  else
    Label2.Caption := 'Помечена';
end;

Когда указатель на запись указывает на запись, которую вы хотите удалить, используйте следующую логику:

Table1.UpdateCursorPos;
Check(DbiUndeleteRecord(Table1.Handle));

Метод UpdateCursorPos устанавливает основной курсор BDE на позицию курсора текущей записи, который существуют только для того, чтобы все работало правильно. Вам нужно только вызвать этот метод прямым вызовом одной из BDE API функций (такой как, например, DbiUndeleteRecord).

Ну и, наконец, чтобы все работало, поместите модули DBIPROCS и DBITYPES с список USES.

Взято из

Взято из "Dtopics Database 1.10 from 3K computer Consultancy":

Пакование таблиц

with Table1 do
StrPCopy(TName, TableName);
Result := DBIPackTable(DbHandle, Handle, TName, szDBASE, TRUE);

Задание видимости удаленных записей - вкл/выкл (например, dBase SET DELETED ON/OFF)

DbiSetProp( hDBIObj(Table1.Handle), curSOFTDELETEON, LongInt(bValue));

Работа с указателями

Cодержание раздела:

Работа с видео и анимацией

Cодержание раздела:

См. также статьи в других разделах:

Работа с визуальными компонентами

Cодержание раздела:

·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·

См. также статьи в других разделах:

Работа с Word через OLE

unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics,      Controls, Forms,      Dialogs, Buttons,ComCtrls, ExtCtrls, OleCtnrs;

type TForm1 = class(TForm)
    OleContainer1: TOleContainer;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    mbLoad: TSpeedButton;
    mbPrint: TSpeedButton;
    OpenDialog1: TOpenDialog;
    procedure mbLoadClick(Sender: TObject);
    procedure mbPrintClick(Sender: TObject);
  private
{ Private declarations }
  public
{ Public declarations }
  end;
var Form1: TForm1; i
  mplementation{$R *.DFM}

procedure TForm1.mbLoadClick(Sender: TObject);
begin
  // Покажем диалог, и если он отработал, то загрузим в контейнер
  if OpenDialog1.Execute and (OpenDialog1.FileName <> '') then
    OleContainer1.CreateObjectFromFile(OpenDialog1.FileName, false);
  / Если загрузилось что - нибудь, то покажем
    if OleContainer1.State <> osEmpty then OleContainer1.DoVerb(ovShow);
end;

procedure TForm1.mbPrintClick(Sender: TObject);
var V: Variant;
begin
  if OleContainer1.State = osEmpty then
    begin
      MessageDlg('OLE не загружен !!', mtError, [mbOk], 0);
      exit;
    end;
// Получаем объект, который воплощает в себе WordBasic интерфейс
  V := OleContainer1.OleObject.Application.WordBasic;
// Командуем до одурения ....
  V.FilePrint; end; end.

Взято с сайта

Работа с запросами

Each function listed below performs a query task, such as preparing and executing a SQL or QBE query.

DbiGetProp:
Returns a property of an object.

DbiQAlloc:
Allocates a new statement handle for a prepared query.

DbiQExec:
Executes the previously prepared query identified by the supplied statement handle and
returns a cursor to the result set, if one is generated.

DbiQExecDirect:
Executes a SQL or QBE query and returns a cursor to the result set, if one is generated.

DbiQExecProcDirect:
Executes a stored procedure and returns a cursor to the result set, if one is generated.

DbiQFree:
Frees the resources associated with a previously prepared query identified by the supplied
statement handle.

DbiQGetBaseDescs:
Returns the original database, table, and field names of the fields that make up the result
set of a query.

DbiQInstantiateAnswer:
Creates a permanent table from the cursor to the result set.

DbiQPrepare:
Prepares a SQL or QBE query for execution, and returns a handle to a statement containing
the prepared query.

DbiQPrepareProc:
Prepares and optionally binds parameters for a stored procedure.

DbiQSetParams:
Associates data with parameter markers embedded within a prepared query.

DbiQSetProcParams:
Binds parameters for a stored procedure prepared with DbiQPrepareProc.

DbiSetProp:
Sets the specified property of an object to a given value.

DbiValidateProp:
Validates a property.

Взято с

Delphi Knowledge Base

Работа с запросами SQL в BDE

Cодержание раздела:

См. также другие разделы:

Работа с железом

Cодержание раздела:

·
·

·
·
·
·
·
·
·
·
·
·
·
·
·
·

·
·
·
·
·
·

·
·
·
·
·
·
·
·
·

·
·
·
·
·
·
·

·
·
·
·
·
·
·
·

(раздел)

·
·

См. также другие разделы:

Работа со справочной системой

Cодержание раздела:

Работа со строками

Cодержание раздела:

См. также статьи в других разделах:

Работа со временем или как реализовать 1.20+1.50=3.10 ?

Автор: Hans Pieters

Если Вы создаёте приложение, в котором пользователь вводит значения времени, то стандартные вычисления не подойдут. Проблема в том, что нужно сделать так, чтобы выражение 1.20 + 1.70 было равно НЕ 2.90 а 3.10.
Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желанию. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm.

function sumhhmm(a, b: double): double;
var
  h1: double;
begin
  h1 := (INT(A) + INT(B)) * 60 + (frac(a) + frac(b)) * 100;
  result := int(h1 / 60) + (h1 - int(h1 / 60) * 60) / 100;
end;

function hhmm2hhdd(const hhmm: double): double;
begin
  result := int(hhmm) + (frac(hhmm) / 0.6);
end;

function hhdd2hhmm(const hhdd: double): double;
begin
  result := int(hhdd) + (frac(hhdd) * 0.6);
end;

Использование:
// sumtime(1.20,1.50) => 3.10
// sumtime(1.20,- 0.50) => 0.30
// hhmm2hhdd(1.30) => 1.5 (1h.30m = 1.5h)
// hhdd2hhmm(1.50) => 1.30 (1.5h = 1h30m)

Взято с Исходников.ru

Работа со звуком

Cодержание раздела:

См. также другие разделы:

См. также статьи в других разделах:

Работает-ли IB с русскими буквами?

Да, как с кодировкой 866 так и с 1251, как из Delphi 1.0, так и из Delphi 2.0. Для того, чтобы в БД в строковых полях использовались русские буквы, необходимо при создании БД указать в качестве дополнительного параметра фразу:

DEFAULT CHARACTER SET WIN1251

А в BDECFG32 в драйвере IB и его псевдонимах (aliases) указать языковый драйвер Pdox ANSI Cyrillic. Такие установки обеспечат нормальную работу с кодировкой 1251. (в TDatabase.Params этот языковый драйвер указывается как LANGDRIVER=ancyrr).

Для компонент прямого доступа необходимо в параметрах соответствующего компонента XXDatabase дописать
lc_ctype=WIN1251

Дополнительно, если вы предполагаете использовать выражение UPPER в SQL запросах, то Вам потребуется при создании таблиц IB использовать уточнение COLLATION SEQUENCE для строковых полей.

К сожалению, установить COLLATE PXW_CYRL по умолчанию для базы данных невозможно (такой параметр отсутствует). Поэтому таблицы IB, созданные при помощи Database Desktop или компонента TTable не будут иметь правильного COLLATE для работы с функцией SQL UPPER. (Эта проблема, необходимо отметить, не относится к работе с регистром русских букв внутри Delphi, поскольку для этого внутри VCL используются функции Windows, правильно переводящие буквы кодировки 1251 в верхний регистр и обратно.)

Например, если возможен запрос такого типа:

SELECT * FROM CUSTOMERS
WHERE UPPER(NAME) = 'ИВАНОВ'

То таблицу CUSTOMERS придется создавать при помощи текста

CREATE TABLE CUSTOMERS (
ID INTEGER NOT NULL,
NAME CHAR(30) COLLATE PXW_CYRL,
PRIMARY KEY (ID))

фраза COLLATE PXW_CYRL заставляет IB использовать таблицу трансляции символов PXW_CYRL вместо WIN1251 (которая устанавливается по умолчанию для DEFAULT CHARACTER SET WIN1251).

Однако можно использовать указание порядка сортировки "на ходу", без указания порядка сортировки в описании таблицы - при помощи того-же спецификатора COLLATE. В этом случае запросы могут выглядеть следующим образом:

SELECT * FROM CUSTOMERS
WHERE UPPER(NAME COLLATE PXW_CYRL) = 'ИВАНОВ'

Учтите, что если Вы используете ORDER BY NAME, то порядок записей у полей с COLLATE PXW_CYRL будет отличаться от имеющих только CHARACTER SET WIN1251. В этом случае необходимо и в ORDER BY указывать COLLATE. Например

SELECT * FROM CUSTOMERS
WHERE UPPER(NAME COLLATE PXW_CYRL) = 'ИВАНОВ'
ORDER BY NAME COLLATE PXW_CYRL

примечание: решить проблему с изменением данных в русской кодировке при использовании ODBC-драйвера можно следующим образом: напрямую указывать кодировку перед строковым значением, содержащим русские символы.

INSERT INTO MYTABLE VALUES (1, _win1251 'Привет!').

К сожалению, такой способ приводит к тому, что со стандартными компонентами TTable и TQuery можно работать только используя дополнительный компонент UpdateSQL (который позволяет переопределить запросы выдаваемые этими компонентами при INSERT, UPDATE, DELETE, и кроме этого присутствует только в Delphi 2.0).

ODBC-драйвер, поставляемый в дистрибутиве IB 5.5 позволяет указать кодировку win1251 для алиаса, при этом никаких манипуляций с _win1251 не требуется.

Подробнее см. документ http:/www.ibase.ru/devinfo/0109.htm

Borland Interbase / Firebird FAQ
Borland Interbase / Firebird Q&A, версия 2.02 от 31 мая 1999
последняя редакция от 17 ноября 1999 года.
Часто задаваемые вопросы и ответы по Borland Interbase / Firebird
Материал подготовлен в Демо-центре клиент-серверных технологий. (Epsylon Technologies)
Материал не является официальной информацией компании Borland.
E-mail mailto:delphi@demo.ru
www: http://www.ibase.ru/
Телефоны: 953-13-34
источники: Borland International, Борланд АО, релиз Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, различные источники на WWW-серверах, текущая переписка, московский семинар по Delphi и конференции, листсервер ESUNIX1, листсервер mers.com.
Cоставитель: Дмитрий Кузьменко

RadioGroup, RadioButton

Cодержание раздела:

Расширяем возможности кнопок в Delphi.

Автор: Maarten de Haan

Пример показывает, как сделать кнопку с тремя состояниями. В обычном состоянии она сливается с формой. При наведении на такую кнопку курсором мышки, она становится выпуклой. Ну и, соотвественно, при нажатии, кнопка становится вогнутой.

Также можно создать до 4-х изображений для индикации состояния кнопки

              <--------- Ширина --------->

              +------+------+-----+------+    ^
              |Курсор|Курсор|нажа-|недос-|    |
              |на кно|за пре| та  |тупна |  Высота
              | пке  |делами|     |      |    |
              +------+------+-----+------+    v

Вы так же можете присвоить кнопке текстовый заголовок. Можно расположить текст и изображение в любом месте кнопки. Для этого в пример добавлены четыре свойства:

TextTop и TextLeft, Для расположения текста заголовка на кнопке,
и:
GlyphTop и GlyphLeft, Для расположения Glyph на кнопке.

Текст заголовка прорисовывается после изображения, потому что они используют одно пространство кнопки, и соответственно заголовок прорисуется поверх изображения. Бэкграунд текста сделан прозрачным. Соответственно мы увидим только текстовые символы поверх изображения.

Найденные баги
----------
1) Если двигать мышку очень быстро, то кнопка может не вернуться в исходное состояние
2) Если кнопка находится в запрещённом состоянии, то при нажатии на неё, будет наблюдаться неприятное мерцание.

Unit NewButton;

Interface

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

Const
   fShift = 2; // Изменяем изображение и заголовок , когда кнопка нажата.
   fHiColor = $DDDDDD; // Цвет нажатой кнопки (светло серый)
               // Windows создаёт этот цвет путём смешивания пикселей clSilver и clWhite (50%).
               // такой цвет хорошо выделяет нажатую и отпущенную кнопки.

Type
  TNewButton = Class(TCustomControl)
  Private
    { Private declarations }
    fMouseOver,fMouseDown              : Boolean;
    fEnabled                          : Boolean;
                                      // То же, что и всех компонент
    fGlyph                            : TPicture;
                                      // То же, что и в SpeedButton
    fGlyphTop,fGlyphLeft              : Integer;
                                      // Верх и лево Glyph на изображении кнопки
    fTextTop,fTextLeft                : Integer;
                                      // Верх и лево текста на изображении кнопки
    fNumGlyphs                        : Integer;
                                      // То же, что и в SpeedButton
    fCaption                          : String;
                                      // Текст на кнопке
    fFaceColor                        : TColor;
                                      // Цвет изображения (да-да, вы можете задавать цвет изображения кнопки

    Procedure fLoadGlyph(G : TPicture);
    Procedure fSetGlyphLeft(I : Integer);
    Procedure fSetGlyphTop(I : Integer);
    Procedure fSetCaption(S : String);
    Procedure fSetTextTop(I : Integer);
    Procedure fSetTextLeft(I : Integer);
    Procedure fSetFaceColor(C : TColor);
    Procedure fSetNumGlyphs(I : Integer);
    Procedure fSetEnabled(B : Boolean);

  Protected
    { Protected declarations }
    Procedure Paint; override;
    Procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    Procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    Procedure WndProc(var Message : TMessage); override;
    // Таким способом компонент определяет - находится ли курсор мышки на нём или нет
    // Если курсор за пределами кнопки, то она всё равно продолжает принимать сообщения мышки.
    // Так же кнопка будет принимать сообщения, если на родительском окне нет фокуса.

  Public
    { Public declarations }
    Constructor Create(AOwner : TComponent); override;
    Destructor Destroy; override;

  Published
    { Published declarations }
    {----- Properties -----}
    Property Action;
    // Property AllowUp не поддерживается
    Property Anchors;
    Property BiDiMode;
    Property Caption : String
       read fCaption write fSetCaption;
    Property Constraints;
    Property Cursor;
    // Property Down не поддерживается
    Property Enabled : Boolean
       read fEnabled write fSetEnabled;
    // Property Flat не поддерживается
    Property FaceColor : TColor
       read fFaceColor write fSetFaceColor;
    Property Font;
    property Glyph : TPicture // Такой способ позволяет получить серую кнопку, которая сможет
                              //   находиться в трёх положениях.
                              // После нажатия на кнопку, с помощью редактора картинок Delphi
                              // можно будет создать картинки для всех положений кнопки..
       read fGlyph write fLoadGlyph;
    // Property GroupIndex не поддерживается
    Property GlyphLeft : Integer
       read fGlyphLeft write fSetGlyphLeft;
    Property GlyphTop : Integer
       read fGlyphTop write fSetGlyphTop;
    Property Height;
    Property Hint;
    // Property Layout не поддерживается
    Property Left;
    // Property Margin не поддерживается
    Property Name;
    Property NumGlyphs : Integer
       read fNumGlyphs write fSetNumGlyphs;
    Property ParentBiDiMode;
    Property ParentFont;
    Property ParentShowHint;
    // Property PopMenu не поддерживается
    Property ShowHint;
    // Property Spacing не поддерживается
    Property Tag;
    Property Textleft : Integer
       read fTextLeft write fSetTextLeft;
    Property TextTop : Integer
       read fTextTop write fSetTextTop;

    Property Top;
    // Property Transparent не поддерживается
    Property Visible;
    Property Width;
    {--- События ---}
    Property OnClick;
    Property OnDblClick;
    Property OnMouseDown;
    Property OnMouseMove;
    Property OnMouseUp;
  end;

Procedure Register; // Hello

Implementation

{--------------------------------------------------------------------}
Procedure TNewButton.fSetEnabled(B : Boolean);

Begin
If B <> fEnabled then
   Begin
   fEnabled := B;
   Invalidate;
   End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetNumGlyphs(I : Integer);

Begin
If I > 0 then
   If I <> fNumGlyphs then
      Begin
      fNumGlyphs := I;
      Invalidate;
      End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetFaceColor(C : TColor);

Begin
If C <> fFaceColor then
   Begin
   fFaceColor := C;
   Invalidate;
   End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetTextTop(I : Integer);

Begin
If I >= 0 then
   If I <> fTextTop then
      Begin
      fTextTop := I;
      Invalidate;
      End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetTextLeft(I : Integer);

Begin
If I >= 0 then
   If I <> fTextLeft then
      Begin
      fTextLeft := I;
      Invalidate;
      End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetCaption(S : String);

Begin
If (fCaption <> S) then
   Begin
   fCaption := S;
   SetTextBuf(PChar(S));
   Invalidate;
   End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetGlyphLeft(I : Integer);

Begin
If I <> fGlyphLeft then
   If I >= 0 then
      Begin
      fGlyphLeft := I;
      Invalidate;
      End;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.fSetGlyphTop(I : Integer);

Begin
If I <> fGlyphTop then
   If I >= 0 then
      Begin
      fGlyphTop := I;
      Invalidate;
      End;
End;
{--------------------------------------------------------------------}
procedure tNewButton.fLoadGlyph(G : TPicture);

Var
   I      : Integer;

Begin
fGlyph.Assign(G);
If fGlyph.Height > 0 then
   Begin
   I := fGlyph.Width div fGlyph.Height;
   If I <> fNumGlyphs then
      fNumGlyphs := I;
   End;
Invalidate;
End;
{--------------------------------------------------------------------}
Procedure Register; // Hello

Begin
RegisterComponents('Samples', [TNewButton]);
End;
{--------------------------------------------------------------------}
Constructor TNewButton.Create(AOwner : TComponent);

Begin
Inherited Create(AOwner);
{ Инициализируем переменные }
Height := 37;
Width := 37;
fMouseOver := False;
fGlyph := TPicture.Create;
fMouseDown := False;
fGlyphLeft := 2;
fGlyphTop := 2;
fTextLeft := 2;
fTextTop := 2;
fFaceColor := clBtnFace;
fNumGlyphs := 1;
fEnabled := True;
End;
{--------------------------------------------------------------------}
Destructor TNewButton.Destroy;

Begin
If Assigned(fGlyph) then
   fGlyph.Free; // Освобождаем glyph
inherited Destroy;
End;
{--------------------------------------------------------------------}
Procedure TNewButton.Paint;

Var
   fBtnColor,fColor1,fColor2,
   fTransParentColor            : TColor;
   Buffer                      : Array[0..127] of Char;
   I,J                          : Integer;
   X0,X1,X2,X3,X4,Y0            : Integer;
   DestRect                    : TRect;
   TempGlyph                    : TPicture;

Begin
X0 := 0;
X1 := fGlyph.Width div fNumGlyphs;
X2 := X1 + X1;
X3 := X2 + X1;
X4 := X3 + X1;
Y0 := fGlyph.Height;
TempGlyph := TPicture.Create;
TempGlyph.Bitmap.Width := X1;
TempGlyph.Bitmap.Height := Y0;
DestRect := Rect(0,0,X1,Y0);

GetTextBuf(Buffer,SizeOf(Buffer)); // получаем caption
If Buffer <> '' then
   fCaption := Buffer;

If fEnabled = False then
   fMouseDown := False; // если недоступна, значит и не нажата

If fMouseDown then
   Begin
   fBtnColor := fHiColor; // Цвет нажатой кнопки
   fColor1 := clWhite;    // Правая и нижняя окантовка кнопки, когда на неё нажали мышкой.
   fColor2 := clBlack;    // Верхняя и левая окантовка кнопки, когда на неё нажали мышкой.
   End
else
   Begin
   fBtnColor := fFaceColor; // fFaceColor мы сами определяем
   fColor2 := clWhite;     // Цвет левого и верхнего края кнопки, когда на неё находится курсор мышки
   fColor1 := clGray;      // Цвет правого и нижнего края кнопки, когда на неё находится курсор мышки
   End;

// Рисуем лицо кнопки :)
Canvas.Brush.Color := fBtnColor;
Canvas.FillRect(Rect(1,1,Width - 2,Height - 2));

If fMouseOver then
   Begin
   Canvas.MoveTo(Width,0);
   Canvas.Pen.Color := fColor2;
   Canvas.LineTo(0,0);
   Canvas.LineTo(0,Height - 1);
   Canvas.Pen.Color := fColor1;
   Canvas.LineTo(Width - 1,Height - 1);
   Canvas.LineTo(Width - 1, - 1);
   End;

If Assigned(fGlyph) then  // Bitmap загружен?
   Begin
   If fEnabled then       // Кнопка разрешена?
      Begin
      If fMouseDown then  // Мышка нажата?
         Begin
         // Mouse down on the button so show Glyph 3 on the face
         If (fNumGlyphs >= 3) then
            TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
               fGlyph.Bitmap.Canvas,Rect(X2,0,X3,Y0));

         If (fNumGlyphs < 3) and (fNumGlyphs > 1)then
            TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
               fGlyph.Bitmap.Canvas,Rect(X0,0,X1,Y0));

         If (fNumGlyphs = 1) then
            TempGlyph.Assign(fGlyph);

         // Извините, лучшего способа не придумал...
         // Glyph.Bitmap.Прозрачность цвета не работает, если Вы выберете в качестве
         // прозрачного цвета clWhite...
         fTransParentColor := TempGlyph.Bitmap.Canvas.Pixels[0,Y0-1];
         For I := 0 to X1 - 1 do
            For J := 0 to Y0 - 1 do
               If TempGlyph.Bitmap.Canvas.Pixels[I,J] =
                  fTransParentColor then
                  TempGlyph.Bitmap.Canvas.Pixels[I,J] := fBtnColor;
         //Рисуем саму кнопку
         Canvas.Draw(fGlyphLeft + 2,fGlyphTop + 2,TempGlyph.Graphic);
         End
      else
         Begin
         If fMouseOver then
            Begin
            // Курсор на кнопке, но не нажат, показываем Glyph 1 на морде кнопки
            // (если существует)
            If (fNumGlyphs > 1) then
               TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
                  fGlyph.Bitmap.Canvas,Rect(0,0,X1,Y0));
            If (fNumGlyphs = 1) then
               TempGlyph.Assign(fGlyph);
            End
         else
            Begin
            // Курсор за пределами кнопки, показываем Glyph 2 на морде кнопки (если есть)
            If (fNumGlyphs > 1) then
               TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
                  fGlyph.Bitmap.Canvas,Rect(X1,0,X2,Y0));
            If (fNumGlyphs = 1) then
               TempGlyph.Assign(fGlyph);
            End;
         // Извиняюсь, лучшего способа не нашёл...
         fTransParentColor := TempGlyph.Bitmap.Canvas.Pixels[0,Y0-1];
         For I := 0 to X1 - 1 do
            For J := 0 to Y0 - 1 do
               If TempGlyph.Bitmap.Canvas.Pixels[I,J] =
                  fTransParentColor then
                  TempGlyph.Bitmap.Canvas.Pixels[I,J] := fBtnColor;
         //Рисуем bitmap на морде кнопки
         Canvas.Draw(fGlyphLeft,fGlyphTop,TempGlyph.Graphic);
         End;
      End
   else
      Begin
      // Кнопка не доступна (disabled), показываем Glyph 4 на морде кнопки (если существует)
      If (fNumGlyphs = 4) then
         TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
            fGlyph.Bitmap.Canvas,Rect(X3,0,X4,Y0))
      else
         TempGlyph.Bitmap.Canvas.CopyRect(DestRect,
            fGlyph.Bitmap.Canvas,Rect(0,0,X1,Y0));
      If (fNumGlyphs = 1) then
         TempGlyph.Assign(fGlyph.Graphic);

      // Извините, лучшего способа не нашлось...
      fTransParentColor := TempGlyph.Bitmap.Canvas.Pixels[0,Y0-1];
      For I := 0 to X1 - 1 do
         For J := 0 to Y0 - 1 do
            If TempGlyph.Bitmap.Canvas.Pixels[I,J] =
               fTransParentColor then
               TempGlyph.Bitmap.Canvas.Pixels[I,J] := fBtnColor;
      //Рисуем изображение кнопки
      Canvas.Draw(fGlyphLeft,fGlyphTop,TempGlyph.Graphic);
      End;
   End;

// Рисуем caption
If fCaption <> '' then
   Begin
   Canvas.Pen.Color := Font.Color;
   Canvas.Font.Name := Font.Name;
   Canvas.Brush.Style := bsClear;
   //Canvas.Brush.Color := fBtnColor;
   Canvas.Font.Color := Font.Color;
   Canvas.Font.Size := Font.Size;
   Canvas.Font.Style := Font.Style;

   If fMouseDown then
      Canvas.TextOut(fShift + fTextLeft,fShift + fTextTop,fCaption)
   else
      Canvas.TextOut(fTextLeft,fTextTop,fCaption);
   End;

TempGlyph.Free; // Освобождаем временный glyph
End;
{--------------------------------------------------------------------}
// Нажата клавиша мышки на кнопке ?
Procedure TNewButton.MouseDown(Button: TMouseButton;
   Shift: TShiftState;X, Y: Integer);

Var
   ffMouseDown,ffMouseOver : Boolean;

Begin
ffMouseDown := True;
ffMouseOver := True;
If (ffMouseDown <> fMouseDown) or (ffMouseOver <> fMouseOver) then
   Begin
   fMouseDown := ffMouseDown;
   fMouseOver := ffMouseOver;
   Invalidate; // не перерисовываем кнопку без необходимости.
   End;
Inherited MouseDown(Button,Shift,X,Y);;
End;
{--------------------------------------------------------------------}
// Отпущена клавиша мышки на кнопке ?
Procedure TNewButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);

Var
   ffMouseDown,ffMouseOver : Boolean;

Begin
ffMouseDown := False;
ffMouseOver := True;
If (ffMouseDown <> fMouseDown) or (ffMouseOver <> fMouseOver) then
   Begin
   fMouseDown := ffMouseDown;
   fMouseOver := ffMouseOver;
   Invalidate; // не перерисовываем кнопку без необходимости.
   End;
Inherited MouseUp(Button,Shift,X,Y);
End;
{--------------------------------------------------------------------}
// Эта процедура перехватывает события мышки, если она даже за пределами кнопки
// Перехватываем оконные сообщения
Procedure TNewButton.WndProc(var Message : TMessage);

Var
   P1,P2 : TPoint;
   Bo    : Boolean;

Begin
If Parent <> nil then
   Begin
   GetCursorPos(P1); // Получаем координаты курсона на экране
   P2 := Self.ScreenToClient(P1); // Преобразуем их в координаты относительно кнопки
   If (P2.X > 0) and (P2.X < Width) and
      (P2.Y > 0) and (P2.Y < Height) then
      Bo := True // Курсор мышки в области кнопки
   else
      Bo := False; // Курсор мышки за пределами кнопки

   If Bo <> fMouseOver then // не перерисовываем кнопку без необходимости.
      Begin
      fMouseOver := Bo;
      Invalidate;
      End;
   End;
inherited WndProc(Message); // отправляем сообщение остальным получателям
End;
{--------------------------------------------------------------------}
End.
{====================================================================}

Взято с Исходников.ru

Растягивание изображения при печати

Я пишу программу, которая печатает изображение на принтере с помощью объекта TPrinter. Проблема происходит когда я пытаюсь "растянуть" изображение до требуемого размера на бумаге. Мой метод растяжения (bitblts и принтерном DC) приводит к белым кляксам, а само изображение получается практически серым. Конечно это не то, что мне хотелось. Кто-нибудь может мне помочь?

Попробуй это:

procedureDrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap:
  TBitmap);
var

  Header, Bits: Pointer;
  HeaderSize: Integer;
  BitsSize: Longint;
begin
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  Header := MemAlloc(HeaderSize);
  Bits := MemAlloc(BitsSize);
  try
    GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
    StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
      DestRect.Right, DestRect.Bottom,
      0, 0, ABitmap.Width, ABitmap.Height, Bits, TBitmapInfo(Header^),
      DIB_RGB_COLORS, SRCCOPY);
{ вам может понадобиться цветовой стандарт DIB_PAL_COLORS,
но это уже выходит за рамки моих знаний. }
  finally
    MemFree(Header, HeaderSize);
    MemFree(Bits, BitsSize);
  end;
end;

{ Печатаем изображение, растягивая его до целого листа }

procedure PrintBitmap(ABitmap: TBitmap);
var
  relheight, relwidth: integer;
begin
  screen.cursor := crHourglass;
  Printer.BeginDoc;
  if ((ABitmap.width / ABitmap.height) > l(printer.pagewidth / printer.pageheight)) then
    begin
{ Растягиваем ширину изображения до ширины бумаги }
      relwidth := printer.pagewidth;
      relheight := MulDiv(ABitmap.height, printer.pagewidth, ABitmap.width);
    end
  else
    begin
{ Растягиваем высоту изображения до высоты бумаги }
      relwidth := MulDiv(ABitmap.width, printer.pageheight, ABitmap.height);
      relheight := printer.pageheight;
    end;
  DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap);
  Printer.EndDoc;
  screen.cursor := crDefault;
end;

Взято из

Советов по Delphi от

Сборник Kuliba

Разбивка строки на слова

Приведу несколько простых функций, позволяющих работать с отдельными словами в строке. Возможно они пригодятся вам для разбивки текстовых полей на отдельные слова (for i := 1 to NumToken do ...) с последующим сохранением их в базе данных.

functionGetToken(aString, SepChar: string; TokenNum: Byte): string;
{
параметры: aString : полная строка

SepChar : единственный символ, служащий
разделителем между словами (подстроками)
TokenNum: номер требуемого слова (подстроки))
result    : искомое слово или пустая строка, если количество слов

меньше значения 'TokenNum'
}
var

  Token: string;
  StrLen: Byte;
  TNum: Byte;
  TEnd: Byte;

begin

  StrLen := Length(aString);
  TNum := 1;
  TEnd := StrLen;
  while ((TNum <= TokenNum) and (TEnd <> 0)) do
  begin
    TEnd := Pos(SepChar, aString);
    if TEnd <> 0 then
    begin
      Token := Copy(aString, 1, TEnd - 1);
      Delete(aString, 1, TEnd);
      Inc(TNum);
    end
    else
    begin
      Token := aString;
    end;
  end;
  if TNum >= TokenNum then
  begin
    GetToken1 := Token;
  end
  else
  begin
    GetToken1 := '';
  end;
end;

function NumToken(aString, SepChar: string): Byte;
{
parameters: aString : полная строка

SepChar : единственный символ, служащий
разделителем между словами (подстроками)
result    : количество найденных слов (подстрок)
}

var

  RChar: Char;
  StrLen: Byte;
  TNum: Byte;
  TEnd: Byte;

begin

  if SepChar = '#' then
  begin
    RChar := '*'
  end
  else
  begin
    RChar := '#'
  end;
  StrLen := Length(aString);
  TNum := 0;
  TEnd := StrLen;
  while TEnd <> 0 do
  begin
    Inc(TNum);
    TEnd := Pos(SepChar, aString);
    if TEnd <> 0 then
    begin
      aString[TEnd] := RChar;
    end;
  end;
  Result := TNum;
end;

// Или другое решение:

function CopyColumn(const s_string: string; c_fence: char;
  i_index: integer): string;
var
  i, i_left: integer;
begin

  result := EmptyStr;
  if i_index = 0 then
  begin
    exit;
  end;
  i_left := 0;
  for i := 1 to Length(s_string) do
  begin
    if s_string[i] = c_fence then
    begin
      Dec(i_index);
      if i_index = 0 then
      begin
        result := Copy(s_string, i_left + 1, i - i_left - 1);
        exit;
      end
      else
      begin
        i_left := i;
      end;
    end;
  end;
  Dec(i_index);
  if i_index = 0 then
  begin
    result := Copy(s_string, i_left + 1, Length(s_string));
  end;
end;

Я знаю что в GetToken параметр SepChar (в моем случае c_fence) строка, не символ, но комментарий гласит, что функция ожидает единственный символ в этой строке, и это очевидно, поскольку если вы пошлете более одного символа, функция попросту несработает. ( Delete(aString,1,TEnd) будет ошибкой, если Length( SepChar ) > 1 ).

Взято из

см. также

Разбудить компьютер по сети, Использование Bios Wake-on-Lan

{$APPTYPECONSOLE}

uses
  SysUtils,
  Classes,
  IdBaseComponent,
  IdComponent,
  IdUDPBase,
  IdUDPClient;

function HexStringToBinString(const HexStr: string): string;
var
  i, l: integer;
begin
  Result := '';
  l := length(HexStr);
  l := l div 2;
  SetLength(Result, l);
  for i := 1 to l do
    if HexToBin(PChar(Copy(HexStr, (i - 1) * 2 + 1, 2)),
      PChar(@Result[i]), 1) = 0 then
      raise Exception.Create('Invalid hex value');
end;

procedure SendMagicPacket(MACAddress: string);
var
  s, packet: string;
  i: integer;
begin
  if Length(MACAddress) <> 12 then
    raise Exception.CreateFmt('Invalid MAC Address: %s', [MACAddress]);
  packet := HexStringToBinString('FFFFFFFFFFFF');
  s := HexStringToBinString(MACAddress);
  for i := 1 to 16 do
    packet := packet + s;
  with TIdUDPClient.Create(nil) do
  try
    Active := true;
    BroadcastEnabled := true;
    Broadcast(packet, 9);
  finally
    Free;
  end;
end;

begin
  if ParamCount <> 1 then
    WriteLn('usage: WakeOnLan MACAddress' + #10 + #13 + 'exmple: WakeOnLan 000102030405')
  else
    SendMagicPacket(ParamStr(1));
end.

Автор:

Song

Взято из

Различные другие железяки...

Cодержание раздела:

См. также статьи в других разделах:

Различные разрешения - различные размеры шрифтов

Я также долго мучился над проблемой решения этого вопроса, и ниже я излагаю свои выводы на основании моих многочисленных экспериментов.

Свойство, отвечающее за размер шрифта важно, но не менее важны в этом вопросе и другие характеристики.

Я получал безобразные результаты при изменении резолюции, пока я не начал задавать размер шрифта в пикселях (pixels) вместо точек (points). Вы можете установить font.height, и вы можете установить font.size. Я обнаружил, что установка значения font.height дает значительно лучшие результаты, поскольку данное свойство определяет количество пикселей, и размер шрифта меняется пропорционально изменению размера пиксела.
Также, вы можете обнаружить, что шрифт по-умолчанию не может быть ниже определенной высоты. Будет гораздо лучше, если вместо SYSTEM вы выберите шрифт MS sans-serif.

У формы имеется свойство, названное "scaling" (взял из памяти, надеюсь верно). Я обнаружил, что лучше его иметь выключенным. Если свойство включено, Delphi или Windows пытаются при изменении размера формы все соответствено смаштабировать. Все это хорошо только для сохранения относительных позиций элементов, так что я выключил свойство, и больше о нем не вспоминал.
Если свойство выключено, а форма ваша максимизирована, вы обнаружите, что все ваши компоненты устремились вслед за левым верхним углом формы. Где не желателен этот эффект, я получал разрешение экрана (Screen.Height и Screen.Width) и прислаивал свойствам компонентов Left и Тор скорректированные свойства прежде, чем форма успевала появиться (в методе OnCreate, во время выполения приложения).

В целом же, завершая рассказ, следует подчеркнуть, что выключенное свойство scaling и использование пикселей вместо точек для изменения размеров шрифта, дает вполне приемлимый результат.

Взято из

Размеры полей таблицы Paradox

Данная общая информация могла бы быть полезной при вычислении максимального размера записи для установки размера каждого блока.

Требования к предельным размерам типов полей таблицы Paradox

Данный список указывает количество байт каждого типа поля таблицы Paradox, занимаемое в структуре записи. Имейте в виду, что указанный размер занимает каждое поля в самом файле .DB, не во вспомогательных файлах типа .MB.

Тип данных           Байт
   -----------------------------------------------------------
   Alphanumeric          1 байт на символ, до 255
   AutoIncrement         4 байта
   Binary (BLOB)        10 байт + 1 на символ. В пределе
                           (0 - 240) [1]
   Bytes                 1 на символ, максимально до 255.
   BCD                  17
   Currency (Денежный)   8
   Date                  4
   Formatted Memo       10 байт + 1 на символ. В пределе
                           (0 - 240)
   Graphic              10 байт + 1 на символ. В пределе
                           (0 - 240)
   Memo                 10 байт + 1 на символ. В пределе
                           (1 - 240) [2]
   Logical               1
   LongInt               4
   Numeric (Числовой)    8
   OLE                  10 байт + 1 на символ. В пределе
                           (0 - 240)
   SmallInt              2
   Time                  4
   TimeStamp             8

Пределы:
   Maximum Field Count      :  255 полей
   (максимальное количество
    полей)
   Maximum Blocks per table :  64К
   (максимальное количество
    блоков в таблице)
   Maximum Block Size       :  32К символов
   (максимальный размер
    блока)
   Max Record Size, unkeyed :  Текущий размер блока - 6 байта [3]
   (максимальный размер
    записи, неключевой)
   Max Record Size, keyed   :  (BlockSize - 6) / 3, округляется в меньшую сторону
   (максимальный размер        до ближайшего размера блока. [4]
    записи, ключевой)
Сноски:
[1] Все blob-поля содержат 10-байтовые указатели на .MB-файл, которые указывают где могут быть найдены "остальные" значения поля.

[2] В отличие от данных "blob"-типа, Memo-поле требует по крайней мере один "Memo"-символ, сохраненный в .DB-файле, для обеспечения совместимости с Paradox for DOS.

[3] Размер блока по умолчанию хранится в IDAPI.CFG. Для изменения значения по умолчанию, запустите Configuration Utility и измените установку Tables, Paradox, Block Size. Значение по умолчанию 2048 и может изменяться в диапазоне от 1024 до 32К. 6 байтов в данном значении резервируются для внутренних указателей.

[4] Это следствие наличия значений ключа записей Paradox, которые передаются в .PX файл, очень похожий на табличный файл. Размер ключа не может превышать 1/3 размера блока таблицы; в противном случае Paradox будет пытаться увеличить размер блока. При выполнении вычислений не забывайте брать в расчет 6-байтные указатели.

- John B Moore

Взято из

Советов по Delphi от

Сборник Kuliba

Разные вопросы

Cодержание раздела:

Разные вопросы, связанные с графикой

Cодержание раздела:

Разработка MDI приложений в Delphi

(перевод одноимённой статьи с delphi.about.com)

Что такое MDI?
MDI расшифровывается как multiple document interface (многодокументный интерфейс). В приложениях с MDI, в основном (родительском) окне можно окрыть более одного дочернего окна. Данная возможность обычно используется в электронных таблицах или текстовых редакторах.

Каждое MDI приложение имеет три основные составляющие:
Одну (и только одну) родительскую форму MDI, Одну и более (обычно больше) дочерних форм MDI, и основное меню MDI.

MDI "мать"
Как уже упоминалось, в проекте MDI приложения может присутствовать только один MDI контейнер (родительская форма) и он должен быть стартовой формой.
Для создания основного окна MDI приложения проделайте следующие шаги:

Запустите Delphi и выберите File | New Application... Delphi создаст новый проект с одной формой под названием form1 (по умолчанию).
В свойстве Name присвойте форме имя frMain.
Установите свойство FormStyle в fsMDIform.
Сохраните этот проект (имя проекта на Ваше усмотрение, например prMDIExample), вместе с uMain.pas в только что созданной директории.
Как Вы успели заметить, для создания основной формы MDI, мы установили свойство FormStyle в fsMDIform. В каждом приложении только одна форма может иметь свойство fsMDIform.

MDI "дети"
Каждое родительское окно MDI нуждается по крайней мере в одной дочерней форме. Дочерние формы MDI - это простые формы, за исключением того, что их видимая часть ограничена размерами родительского окна. Так же при минимизации такого окна, оно помещается не в панель задач, а остаётся внутри родительского окна ( на панель задач попадёт только родительское окно).

Теперь давайте создадим дополнительные формы, а точнее дочерние. Просто выберите File | New Form. Будет создан новый объект формы с именем form1 (по умолчанию). При помощи Object Inspector измените свойство Name в форме form1 на frChild, а свойство FormStyle на fsMDIChild. Сохраните эту форму с соответствующим ей файлом как uchild.pas. Обратите внимание, что при помощи данного свойства мы можем превратить любую существующую форму в дочернюю форму MDI.
Ваше приложение может включать множество дочерних MDI форм такого же или другого типа.

Так же хочется обратить Ваше внимание, что MDI приложение может включать в себя и самые обычные формы, но в отличие от дочерних, они будут отображаться как обычные модальные диалоговые окна (такие как about box, или файловый диалог).

Естевственно, что как на родительском так и на дочернем окнах можно располагать любые элементы управления, однако уже давно сложилась традиция, что на родительской форме располагается панель статуса (status bar) и панель инструментов (toolbar), в то время как на дочерних формах располагаются все остальные контролы, такие как гриды, картинки, поля вводи и т. д.

Автосодание -> Доступные
Теперь давайте произведём некоторые настройки нашего проекта. Выберите Project | Options, откроется диалог опций проекта (Project Options). В левой панели выберите frChild (Авто-создание форм ("Auto-create forms")), и переместите её в правую панель (Доступные формы (Available forms)). Список правой панели содержит те формы, которые используются Вашим приложением, но которые не созданы автоматически. В MDI приложении, по умолчанию, все дочерние формы создаются автоматически и отображаются в родительской форме.

Создание и отображение...
Как упомянуто выше, настройка не позволяет автоматически создавать дочерние окна, поэтому нам необходимо добавить некоторый код, который будет производить создание объекта формы frChild. Следующую функцию CreateChildForm необходимо поместить внутри основной формы (MDI родитель) (наряду с заголовком в interface's private):

uses uchild;
...
procedure TfrMain.CreateChildForm
         (const childName : string);
  var Child: TfrChild;
begin
  Child := TfrChild.Create(Application);
  Child.Caption := childName;
end;

Данный код создаёт одну дочернюю форму с заголовком childName.
Не забудьте, что этот код находится разделе "uses uchild".

На закрытие не минимизировать!
Закрытие дочернего окна в MDI приложении всего навсего минимизирует его в клиентской области родительского окна. Поэтому мы должны обеспечить процедуру OnClose, и установить параметр Action в caFree:

procedure TfrChild.FormClose
      (Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;

Обратите внимание, что если форма является дочерней формой MDI, и её свойство BorderIcons установлено в biMinimize (по умолчанию), то опять же по умолчанию параметр Action установлен в caMinimize. Если же в дочерней форме MDI нет этих установок, то по умолчанию Action установлен как caNone, означающий, что при закрытии формы ничего не случится.

MDI родительское меню
Каждое MDI приложение должно иметь основное меню с (если больше ничего нет), опцией выравнивания окон. Поскольку мы предварительно переместили дочернюю форму из Авто-создаваемых (Auto-create) в Доступные (Available) формы, то нам нужен будет код, который (пункт меню) будет создавать дочерние формы.

Для создания дочерних окон в нашем приложении будет использоваться пункт меню "New child". Второе меню (Window) будет использоваться для выравнивания дочерних окошек внутри родительского окна-формы.

...Создать и отобразить
В заключении нам необходимо сделать обработчик для пункта меню "New child". При нажатии на пунк меню File | New Child нашего приложения, будет вызываться процедура NewChild1Click которая в свою очередь будет вызывать процедуру CreateChildForm (приведённую выше), для создания (следующего) экземпляра формы frChild.

procedure TfrMain.NewChild1Click(Sender: TObject);
begin
CreateChildForm('Child '+IntToStr(MDIChildCount+1));
end;

Только что созданная дочерняя форма будет иметь заголовок в виде "Child x", где x представляет количество дочерних форм внутри MDI формы, как описано ниже.

Закрыть всё
При работе с приложением, имеющим многодокументный интерфейс, всегда необходимо иметь процедуру, закрывающую все дочерние окна.

procedure TfrMain.CloseAll1Click(Sender: TObject);
var i: integer;
begin
  for i:= 0 to MdiChildCount - 1 do
    MDIChildren[i].Close;
end;

Вам прийдётся выполнять проверку на предмет наличия несохранённой информации в каждом дочернем окне. Для решения данной задачи лучше всего использовать обработчик события OnCloseQuery.

Свойства MdiChildCount и MDIChildren
MdiChildCount свойство read only, содержащее в себе количество созданных дочерних окошек. Если не создано ни одно дочернее окно, то это свойство установлено в 0. Нам прийдётся частенько использовать MdiChildCount наряду с массивом MDIChildren. Массив MDIChildren содержит ссылки на объекты TForm всех дочерних окошек.

Обратите внимание, что MDIChildCount первого созданного дочернего окна равен 1.

Меню Window
Delphi обеспечивает большинство команд, которые можно поместить внутри пункта меню Window. Далее приведён пример вызова трёх основных методов для команд, которые мы поместили в наше приложение:

procedure TfrMain.Cascade1Click(Sender: TObject);
begin
  Cascade;
end;

procedure TfrMain.Tile1Click(Sender: TObject);
begin
  Tile;
end;

procedure TfrMain.ArrangeAll1Click(Sender: TObject);
begin
  ArrangeIcons;
end;

Взято с Исходников.ru

Разработка Plug in

Cодержание раздела:

Разработка приложений

Cодержание раздела:

·
·
·
·
·
·

·
·
·
·

·
·
·
·
·
·
·

·
·

См. также статьи в других разделах:

См. также другие разделы:

Разработка внешних Stored Procedures

Answer:

Writing MS SQL Server Extended Stored Procedures with Delphi

Microsoft SQL Server 6.5 and 7 have the powerful capability to make functions in DLL's available as stored procedures. Microsoft calls them Extended Stored Procedures. If you've read this article, you know what Extended Stored Procedures are, what you can do with them, and how to install them on a SQL Server. You should also be able to use the object-oriented framework I wrote, which makes writing Extended Stored Procedures with Delphi extremely easy.

I assume you are familiar with SQL Server and with the concept of stored procedures. The code and examples in this article apply both to SQL Server 6.5 and SQL Server 7.

What are Extended Stored Procedures?

Extended Stored Procedures (called xp's afterwards) are part of Microsoft's Open Data Services (ODS) for SQL Server. With ODS you can do three things:

1.Making routines in a DLL available as stored procedures to any SQL Server user.
2. Write procedure server applications. They are similar to xp's, however they run as a separate network server application and could even be running on a different machine (3-tier).
3. Writing gateways to non-SQL Server based environments.

In the following figure a graphical overview of the ODS architecture is given.

In this article I discuss the art of writing stored procedures with Delphi. Technically this DLL is part of SQL server, therefore programmer errors may corrupt your SQL Server, so it's not an art without danger.

Making parts of your application available on the server has some advantages, for example:

1.   Some things are easy to write in Delphi, but difficult or impossible using Transact SQL. For example you might use some routines written in a language you don't understand or don't have the source code for, so you can't translate it to Transact SQL (with the possibility of errors creeping in during this translation).
2.   Delphi routines run much faster than Transact SQL. Take for example numerical calculations.
3.   You can interface with other programs, databases and such. For example you could write an xp that accepts the name of a paradox table and returns the contents of this table as a SQL Server result set.

Xp's live in DLL's and can therefore be written in any language which can produce DLL's like Delphi can. Before going into detail about how to write xp's, first some examples from a user's point of view. Let's assume we have an xp called xp_incbyone1 which increments a given number by one. We can call xp_incbyone1 as followings:

   declare
     @mynumber integer
   select @mynumber = 1
   exec master..xp_incbyone1 @mynumber output
   select @mynumber

The declare statement declares a variable @mynumber of type integer. Next we set it to one, pass it to the xp and allow the xp to modify it by appending output to the parameter. Finally we display the number with a select statement to see if it has been updated. The result should be 2 of course.

In this example we have an xp which returns an output parameter. Xp's can also return a result set. The example xp_incbyone2 returns the number as a result set. The code to call it would be:

   declare
    @mynumber integer

   select @mynumber = 1

   exec master..xp_incbyone2 @mynumber

xp_incbyone2 will return a table of just one column and one row containing the value 1.

Both xp_incbyone1 and xp_incbyone2 are described in detail in the next section where I present the framework.

As you see, for users extended stored procedures work exactly like stored procedures. Just like stored procedures, extended stored procedures can return parameters and/or result sets.

Each implementation of an xp needs to do the same things:

1.   Check that the caller of the procedure has provided all of the required parameters and that each parameter is of the appropriate data type. Return an appropriate message if not.
2.   Define the columns for returning a result set.
3.   Create each record for returning to the caller.
4.   Set up any output parameters and return statuses used by the procedure.
5.   When finished returning results, send the results completion message using srv_senddone with the SRV_DONE_MORE status flag.
6.   Return from the procedure with the desired Transact-SQL return status.

Step 1 is necessary because, unless normal stored procedures, it is up to the programmer to validate any user-specified parameters for xp's. Step 2 and 3 are optional, and are applicable only if you return a result set. Step 4 is also optional, and applies only if you return output parameters.

Writing xp's with Delphi

The C programmer who wants to develop xp's has to install the SQL Server 7 development tools. This option can be turned on when installing SQL Server 7. In the directory \MSSQL7\devtools\ you will find all the required header files and demo-programs. Unfortunately, Inprise did not supply a translation of these header files with Delphi. Therefore I had to translate the most important parts by hand to Delphi. This means that you don't need to install the SQL Server 7 development tools if you use this framework to write xp's. If you want to add more pieces you will need this resource kit though. Or you can ask me if I've time to expand the framework a bit to cover the missing pieces. Note: in previous version of SQL Server the development tools were part of the the BackOffice resource kit.

In the previous paragraph 6 steps were mentioned each xp has to do. The framework makes step 1 through 4 easier by taking care of details. You also can use Delphi types, because the framework does type translation between SQL Server types and Delphi types. The framework takes entirely care off step 5 and 6.

You use this framework as follows:

1.   Create an object of class TSQLXProc and implement its Execute method.
2.   Write a procedure that allocates this object, calls it's Run method and frees the object. The name of this procedure should be equal to the name of your extended stored procedure. It's calling method should be stdcall.

To make this more concrete, let's implement the xp_incbyone1 stored procedure. The 1st step is to create a new object based on TSQLXProc and implement its Execute method. It's header looks like this:

type
  TXPIncByOne1 = class(TSQLXProc)
    function Execute: Boolean; override;
  end;

The Execute method looks like this:

function TXPIncByOne1.Execute: Boolean;
begin
  Params[1] := Params[1] + 1;
  Result := True;
end;

The 2nd step is to write a procedure that calls this object. This is the procedure that SQL Server is actually calling. For xp_incbyone1 it looks like this:

function xp_incbyone1(srvproc: PSRV_PROC): SRVRETCODE; stdcall;
const
  ExpectedParams = 1;
var
  xp: TSQLXProc;
begin
  xp := TXPIncByOne1.Create(srvproc, ExpectedParams);
  Result := xp.Run;
  xp.Free;
end;

It's that easy!

Let's look in more detail to the first step. The only thing you'll ever need to do is to implement the Execute method. This function returns True or False. If False is returned, an error is returned to the calling application or user. Exceptions are caught by the code that calls your Execute method and a similar error is returned to the calling application or user.

You have access to the parameters of a stored procedure by using the variant array Params. Parameters are numbered from one onwards. As noted earlier SQL Server does no type checking on xp parameters. The framework returns parameters as variants, so it's a bit more robust against different parameters, but variant conversion errors may occur if a parameter type mismatches. You might want to use the ODS API call srv_paramtype to explicitly retrieve and check parameter types, but so far I've not found a need this. Another solution for checking parameter types is to use the VarType function. See Table 1 for a list of Transact-SQL data types and corresponding Delphi data types.

If a parameter is Null, the Params property returns the variant type Null. Equally, if you want to return Null, set the corresponding parameter in Params to Null.

Let's look in more detail to the second step. This step will probably always be the same except for the value of the ExpectedParams const and the particular object to instantiate. This procedure is called by SQL Server with one parameter: srvproc. We pass this parameter to the instantiated object and we pass it the number of parameters to expect. If the actual number of parameters is different from this an error message will be send back to the calling application/user. Pass zero if you don't want to check for the number of parameters, for example to support a variable number of parameters.

Next we call the Run method of the instantiated object, which in turn will call our Execute method (surrounded by for example a try..except block). Finally we free the object.

Now let's tackle an xp which returns a result set. It's header is this:

type
  TXPIncByOne2 = class(TSQLXProc)
    function Execute: Boolean; override;
  end;

It's body is this:

function TXPIncByOne2.Execute: Boolean;
var
  myint: integer;
begin
  DescribeColumn('my column name', SRVINT4, 4, SRVINT4, 4, @myint);
  Myint := Params[1] + 1;
  SendRow;
  Result := True;
end;

And the procedure to call this object is this:

function xp_incbyone2(srvproc: PSRV_PROC): SRVRETCODE; stdcall;
const
  ExpectedParams = 1;
var
  xp: TSQLXProc;
begin
  xp := TXPIncByOne2.Create(srvproc, ExpectedParams);
  Result := xp.Run;
  xp.Free;
end;

We now have a bit more complicated Execute method. In case we want to return a result set, we need to describe every row in the resulting table: its column name, its destination type, its destination length, its source type, its source length and a pointer to the source data. You should call DescribeColumn for every column in the result table. The next step is to fill the source data, that's the assignment to myint. The row is now complete, so we can send it to SQL Server using SendRow. You should prepare source data and call SendRow for every row in the result table. And finally just return True and exit. After that SQL Server will send the entire result table to the client.

The xp_incbyone2 procedure is still a simple call the object and exit. In the remaining examples I will omit this procedure.

Table 1: supported types for use with DescribeColumn.

ODS constant     TSQL data type(s)   Delhi data type(s)
SRVVARCHAR    varchar   string
SRVCHAR    char     string
SRVINTN   tinyint, smallint, int    shortint,smallint,integer
SRVBIT     bit    Boolean
SRVDECIMAL   numeric/decimal   n/a (string)
SRVNUMERIC   numeric/decimal   n/a (string)
SRVFLTN   real, float   single, double
SRVMONEYN   smallmoney, money   n/a (integer, DBMONEY)
SRVDATETIMN   smalldatetime, datetime   TDateTime

I implemented two xp's from the sample xp's which Microsoft implemented in xp.c. The first one simply copies the contents of the first parameter to the second parameter. The second one returns the free space from every drive available on the SQL Server computer.

To avoid name clashes I called the first xp xp_delphiecho instead of xp_echo. The second one is called xp_delphidisklist instead of xp_disklist. Especially xp_echo looks ways more elegant than the Microsoft's sample program. You really should have a look at xp.c!

The code for xp_delphiecho is:

function TXPEcho.Execute: Boolean;
begin
  Params[2] := Params[1];
  Result := True;
end;

The code for xp_delphidisklist is:

function TXPDiskList.Execute: Boolean;
var
  drivename: char;
  space_remaining: Int32;
  drivenums: Int32;
  rootname: string;
  SectorsPerCluster,
    BytesPerSector,
    NumberOfFreeClusters,
    TotalNumberOfClusters: dword;

  function IsDrive(drive: char): Boolean;
  begin
    IsDrive := (drivenums and (1 shl (Ord(drive) - Ord('A')))) <> 0;
  end;

begin
  DescribeColumn('drive', SRVCHAR, 1, SRVCHAR, 1, @drivename);
  DescribeColumn('bytes free', SRVINT4, 4, SRVINT4, 4, @space_remaining);
  drivenums := GetLogicalDrives;
  for drivename := 'C' to 'Z' do
  begin
    if IsDrive(drivename) then
    begin
      rootname := drivename + ':\';
      GetDiskFreeSpace(
        PChar(rootname),
        SectorsPerCluster,
        BytesPerSector,
        NumberOfFreeClusters,
        TotalNumberOfClusters);
      space_remaining := SectorsPerCluster * NumberOfFreeClusters * BytesPerSector;
      SendRow;
    end;
  end;
  Result := True;
end;

In the first two lines the description of the result table is given. The result table consists of two columns 'drive' and 'bytes free'. Next for every drive we fill the variables drivename and space_remaining and send back the row using SendRow.

The framework in more detail

The framework itself is in the unit odsxp.pas. In the following figure you see how this framework fits within the ODS architecture.

SQL Server loads and calls the DLL. You have written a simple method which creates an object of type TSQLXProc. You call its Run method.

The Run method does some checks and calls you back on a method you have written, the Execute method. When you are finished, you return to Run, which in return sends the results back to SQL Server.

Installing xp's on SQL Server

All of the material in this section can also be found in the Microsoft SQL Programmers Toolkit or in the Microsoft Transact-SQL reference.

Installing xp's differs between SQL Server 6.5 and SQL Server 7.0. Everything that works under SQL Server 6.5 also works under SQL Server 7.

Installing xp's on SQL Server 7

Installing an extended stored procedure on SQL Server 7 can be done using the SQL Enterprise manager:

1.Open a server.
2.   Go to item `Databases'.
3.   Select the master database.
4.   Right click it and choose `New Extended Stored Procedure', see figure below
5.   Give the name of a function in the DLL and the location and name of the DLL itself.

Installing xp's on SQL Server 6.5

When you have compiled your DLL you have to install it in the appropriate directory. Copy the file to the same directory as the standard SQL Server DLL files. Usually this directory is something like c:\mssql\binn, note binn with two n's not the bin directory with a single n which also exists! As with other DLL's, once the extended stored procedure DLL is placed in the appropriate directory and the appropriate paths are set, you can make its functions available to users immediately. It is not necessary to restart the server.

For each function provided in an extended stored procedure DLL, a SQL Server system administrator must run the sp_addextendedproc system procedure, specifying the name of the function and the name of the DLL in which that function resides. For example:

sp_addextendedproc 'xp_delphiecho', 'xpdelphi.dll'

This command registers the function xp_delphiecho, located in the file xpdelphi.dll, as a SQL Server extended stored procedure. You must run sp_addextendedproc in the master database.

To drop individual extended stored procedures, a system administrator uses the system procedure sp_dropextendedproc.

Once a system administrator has added an extended stored procedure, users can find out what new functions are available by using the system procedure sp_helpextendedproc. When used without an argument, sp_helpextendedproc displays all extended stored procedures that are currently registered with the master database. If you specify an extended stored procedure name as an argument, sp_helpextendedproc verifies whether that function is currently available.

Extended Stored Procedures are subject to the same security mechanisms as regular stored procedure. For example to give every right on the xp_delphiecho xp, run the following command in the master database:

grant exec on xp_delphiecho to public

Calling extended stored procedures

Every user can now call xp_delphiecho from every database by prefixing xp_delphiecho with 'master..'. For example to call xp_delphiecho from the pubs database you say:

exec master..xp_delphiecho @paramin, @paramout output

Unloading extended stored procedures

SQL Server loads an extended stored procedure DLL as soon as a call is made to one of the DLL's functions. The DLL remains loaded until the server is shut down or until the system administrator uses the DBCC command to unload it. For example:

DBCC xpdelphi(FREE)

This command unloads xpdelphi.dll, allowing the system administrator to copy in a newer version of this file without shutting down the server. You probably will need this command quite a lot to debug your xp's!

Взято с

Delphi Knowledge Base

Развертывание приложения, использующего dbExpress

Автор: Андрей Пащенко
Специально для Королевства Delphi

Начиная с Delphi 6 в палитре компонентов появилась новая закладка dbExpress. В настоящее время данные "кирпичики" широко используются в приложения для доступа к различным базам данных. Однако развернув готовое приложение на компьютере, без установленной Delphi, разработчик недоумевает о неработоспособности приложения. Возникает резонный вопрос: ЧТО ДЕЛАТЬ?

Согласно справочной системе Delphi корректную работу вашего приложения в операционной системе Windows можно обеспечить двумя способами: в виде одного exe файла, либо используя дополнительные DLL библиотеки.

Первый способ - единый exe файл

Все что необходимо сделать для нормальной работы вашего приложения это добавить в оператор USES ссылку на три DCU файла, находящихся в директории Lib (по умолчанию C:\Program Files\Borland\Delphi6\Lib\).

Первый файл имеет имя Crtl. Ссылку на него необходимо добавлять всегда, когда в приложении используется dbExpress и планируется обойтись без дополнительных DLL.

Если в программе используются классы TSQLClientDataSet, TClientDataSet или их потомки, возникает необходимость добавления ссылки на файл MidasLib.

В зависимости от используемого SQL сервера в оператор USES необходимо добавить:

для MySQL - dbExpMy (в случае установленного Service Pack 2 - dbExpMySQL);
для InterBase - dbExpInt;
для Oracle - dbExpOra;
для DB2 - dbExpDb2
Второй способ - применение дополнительных DLL.

Работу механизма dbExpress в программе выполняют две библиотеки. Их имена совпадают с именами DCU файлов.

При наличии в устанавливаемом приложении классов TSQLClientDataSet, TClientDataSet или их потомков необходимо наличие файла Midas.dll.

Вторая DLL обеспечивает связь с конкретным SQL сервером:

для MySQL - dbexpmy.dll (в случае установленного Service Pack 2 - dbExpMySQL.dll);
для InterBase - dbexpint.dll;
для Oracle - dbExpOra.dll;
для DB2 - dbExpDb2.dll
Все дополнительные библиотеки должны находится либо в директории вашей программы, либо в директориях указанных в переменной PATH. Например: C:\Windows\SYSTEM\ или C:\Winnt\SYSTEM32\

Независимо от выбранного способа вам вероятно потребуется и дополнительная DLL для доступа к серверу, которую можно найти в дистрибутиве используемого вами SQL сервера (например для MySQL это файл libmySQL.dll).

Что же выбрать?

В череде экспериментов in vitro (т.е. в искусственных условиях) были выявлены только два различия.

Различие №1. Размеры распространяемого приложения.

Если вы обходитесь без дополнительных DLL библиотек, то ваш exe файл увеличивается в размере.

Приложение для тестов:

Тестовый пример состоял из формы на которой размещены два не визуальных компонента: TSQLConnection, TSQLClientDataSet. Компоненты настроены для работы с SQL сервером MySQL. Все настройки компиляции установлены по умолчанию.

Размер EXE файла без дополнительных DLL больше после компилирования на 245248 байта (239,5 Кб). В то же время суммарный размер одного приложения без дополнительных DLL меньше на 140800 байта (137,5 Кб) (табл. 1).

Таблица 1. Размеры распространяемых файлов для приложения использующего dbExpress для доступа к SQL серверу

Типфайла Размер файлов необходимых для приложения без дополнительных DLL(байты) Размер файлов необходимых для приложения с дополнительными DLL(байты)
Исполняемый файл 985600 740352
Дополнительные DLL
для MySQL - dbexpmysql.dll - 92160
Midas.dll - 293888
ИТОГО 985600 1126400

Таким образом если на компьютере используется больше, чем одно приложение, то выгода от использования дополнительных DLL очевидна.

Различие №2. Реестр Windows.

Если приложение использует дополнительные DLL, то при первом запуске приложения в реестре добавляются ссылки на файл Midas.dll. (см. файл MidasReg.zip).

При перемещении или удалении файла из данного места все приложения использующие Midas.dll перестают работать. Для восстановления работоспособности приходится вручную удалять данные записи из реестра.

Приемлемым выходом из данной ситуации можно считать размещение данной библиотеки в системной директории Windows (C:\Windows\SYSTEM\ или C:\Winnt\SYSTEM32\).

Если приложение распространяется без Midas.dll или dbExpress используется в DLL, то данных изменений в реестре на наблюдается.

Таким образом если необходимо избежать "мусора" в реестре, то необходимо подготовить ваше приложения к работе без дополнительных DLL.

Взято из

Развлечения

Cодержание раздела:

См. также статьи в других разделах:

Reading the autoincrement value of Paradox table

The current highest value is stored beginning at byte 73 decimal.
The next value is determined by adding 1 to it.

Here is a simple Delphi function that returns the current
autoincrement value.

function getAutoInc(filename: string): LongInt;
var
  mystream: tfilestream;
  buffer: longint;
begin
  mystream := tfilestream.create(filename,
    fmOpenread + fmShareDenyNone);
  mystream.Seek(73, soFromBeginning);
  mystream.readbuffer(buffer, 4);
  mystream.Free;
  getAutoInc := buffer;
end;

Реакция компонентов на клавиатуру

Cодержание раздела:

См. также другие разделы:

См. также статьи в других разделах:

RecCount в таблицах ASCII

В Delphi 1.0 для получения количества записей в ASCII файле (.TXT- и .SCH-файлы) я пользовался свойством RecordCount компонента TTable. В Delphi 2.0 эта функциональность не поддерживается! Я прав или не прав? Во всяком случае как мне получить количество записей, содержащихся в ASCII таблице?

В Delphi 2.0, свойство RecordCount отображается на недокументированную функцию BDE DbiGetExactRecordCount. Данное изменение было сделано для обеспечения правильных величин при работе с "живыми" запросами. Очевидно, данное API по какой-то причине не поддерживает текстовые файлы.

Вы можете обойти эту проблему, вызывая функцию API BDE DbiGetRecordCount напрямую (добавьте BDE к списку используемых модулей):

procedureTForm1.FormKeyUp(Sender: TObject; var Key: Word);
var
RecCount: Integer;
begin
Check(DbiGetRecordCount(Table1.Handle, RecCount);
end;

Взято из

Редактор свойства Color с заданными ограничениями

Редактор свойства, пример которого приведен ниже, имеет ограничение на устанавливаемые цвета: только clRed, clWhite или clBlue.

unitClrComps;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes,
  Graphics, Controls, Forms, Dialogs, DsgnIntf;

type
  TColorComponent = class(TComponent)
  private
    FColor: TColor;
  protected
    procedure SetColor(Value: TColor);
  public
    constructor Create(AnOwner: TComponent); override;
  published
    property Color: TColor read FColor write SetColor;
  end;

{ Это специальный редактор свойства выбора цветов... }
  TMyColorProperty = class(TIntegerProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

procedure Register;

implementation

{ TMyColorProperty }

function TMyColorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList];
end;

function TMyColorProperty.GetValue: string;
begin
  Result := ColorToString(TColor(GetOrdValue));
end;

procedure TMyColorProperty.GetValues(Proc: TGetStrProc);
begin
  Proc('clRed');
  Proc('clWhite');
  Proc('clBlue');
end;

procedure TMyColorProperty.SetValue(const Value: string);
var
  NewValue: Longint;
begin
  if IdentToColor(Value, NewValue) and
    ((NewValue = clRed) or
    (NewValue = clWhite) or
    (NewValue = clBlue)) then
    SetOrdValue(NewValue);
end;

{ Образец компонента... }

constructor TColorComponent.Create(AnOwner: TComponent);
begin
  inherited Create(AnOwner);
  FColor := clRed;
end;

procedure TColorComponent.SetColor(Value: TColor);
begin
  if (Value = clRed) or
    (Value = clWhite) or
    (Value = clBlue) then
    begin
      FColor := Value;
    end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TColorComponent]);
  RegisterPropertyEditor(TypeInfo(TColor), TColorComponent,
    'Color', TMyColorProperty);
end;

end.

- Ed Jordan

Взято из

Советов по Delphi от

Сборник Kuliba

Реестр и INI файлы

Cодержание раздела:

Регионарные стандарты

В Дельфи есть предопределенные переменные языковых установок и форматов:

SysUtils

The following are a set of variables used to define the format for numeric or date/time strings:

var CurrencyString: string;
var CurrencyFormat: Byte;
var NegCurrFormat: Byte;
var ThousandSeparator: Char;
var DecimalSeparator: Char;
var CurrencyDecimals: Byte;
var DateSeparator: Char;
var ShortDateFormat: string;
var LongDateFormat: string;
var TimeSeparator: Char;
var TimeAMString: string;
var TimePMString: string;
var ShortTimeFormat: string;

var LongTimeFormat: string;
var ShortMonthNames: array[1..12] of string;
var LongMonthNames: array[1..12] of string;
var ShortDayNames: array[1..7] of string;
var LongDayNames: array[1..7] of string;

var SysLocale: TSysLocale;
var EraNames: array[1..7] of string;
var EraYearOffsets: array[1..7] of Integer;
var TwoDigitYearCenturyWindow: Word = 50;

var TListSeparator: Char;

Автор ответа: Vit
Взято с Vingrad.ru

Регистрация редактора свойства

Скажем, вы имеете компонент TContainer, содержащий TContainedClass в свойстве с именем 'Contained' - попробуйте добавить следующую строку к процедуре Register вашего компонента:

RegisterPropertyEditor(TypeInfo(TContainedClass),
TContainer,
'Contained',
TClassProperty);

Не забудьте добавить TypInfo и DsgnIntf в список используемых модулей.

Все это задокументировано в справке помощи. Первым параметром всегда идет TypeInfo() с "коллекционируемым" классом в качестве параметра, затем контейнерный класс или NIL, если он должен работать для всех экземпляров контейнерного класса с заданным свойством, затем идет имя контейнерного свойства или '', если редактор должен работать для всех свойств, и завершает славную четверку параметров класс TClassProperty, расширяющий классовое свойство, т.е. "создающий" знак "+" в Инспекторе Объектов, позволяющий редактировать вложенные свойства (щелчок на плюсике раскрывает список вложенных свойств описываемого контейнерного класса).

Mike Scott
Mobius Ltd.

Взято из

Советов по Delphi от

Сборник Kuliba

Регистрируем горячие клавиши

Пример демонстрирует установку горячей клавиши CTRL-F7:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure WMHotKey(var Message: TMessage); message WM_HOTKEY;
  end;

var
  Form1: TForm1;
implementation

{$R *.DFM}
procedure Tform1.WMHotKey(var Message: TMessage);
begin
  application.Restore;
  application.bringtofront;
  showmessage('Нажата CTRL-F7!');
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  RegisterHotKey(form1.Handle,123,mod_control,vk_f7);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnregisterHotKey(Handle, 123)
end;

end.

Взято с Исходников.ru