nyuuzyou/wikis huggingface dataset:
Наклон изображения

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Наклон изображения по вертикали и горизонтали
Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 2 июня 2002 г.
***************************************************** }
procedure InclinationBitmap(Bitmap: TBitmap; Hor, Ver: Double; BackColor: TColor);
 function Tan(X: Extended): Extended;
 // Tan := Sin(X) / Cos(X)
 asm
 FLD X
 FPTAN
 FSTP ST(0) // FPTAN pushes 1.0 after result
 FWAIT
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y, WW, HH, alpha: Integer;
 OldPx, NewPx: PRGB;
 T: Double;
 Bmp: TBitmap;
begin
 Bitmap.PixelFormat := pf24Bit;
 Bmp := TBitmap.Create;
 try
 Bmp.Assign(Bitmap);
 WW := Bitmap.Width;
 HH := Bitmap.Height;
 if Hor <> 0.0 then
 begin // По горизонтали
 T := Tan(Hor * (Pi / 180));
 Inc(WW, Abs(Round(HH * T)));
 Bitmap.Width := WW;
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 for y := 0 to HH - 1 do
 begin
 if T > 0 then
 alpha := Round((HH - y) * T)
 else
 alpha := -Round(y * T);
 OldPx := Bmp.ScanLine[y];
 NewPx := Bitmap.ScanLine[y];
 Inc(NewPx, Alpha);
 for x := 0 to Bmp.Width - 1 do
 begin
 NewPx^ := OldPx^;
 Inc(NewPx);
 Inc(OldPx);
 end;
 end;
 Bmp.Assign(Bitmap);
 end;
 if Ver <> 0.0 then
 begin // По вертикали
 T := Tan(Ver * (Pi / 180));
 Bitmap.Height := HH + Abs(Round(WW * T));
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 for x := 0 to WW - 1 do
 begin
 if T > 0 then
 alpha := Round((WW - x) * T)
 else
 alpha := -Round(x * T);
 for y := 0 to Bmp.Height - 1 do
 begin
 NewPx := Bitmap.ScanLine[y + alpha];
 OldPx := Bmp.ScanLine[y];
 Inc(OldPx, x);
 Inc(NewPx, x);
 NewPx^ := OldPx^;
 end;
 end;
 end;
 finally
 Bmp.Free;
 end;
end;
// Пример использования:
InclinationBitmap(FBitmap, 7.151, -5.8, clWhite);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03834
Category:Графика
Category:Bitmap
Напечатать миллиметровку

program PrnGrid;
uses
 Dialogs,
 Printers,
 Windows,
 Types;
{$R *.res}
function GetPenWidth(I: Integer): Integer;
begin
 if I mod 100 = 0 then
 Result := 45
 else if I mod 50 = 0 then
 Result := 30
 else if I mod 10 = 0 then
 Result := 20
 else if I mod 5 = 0 then
 Result := 15
 else
 Result := 10;
end;
var
 PageRect: TRect;
 I, J: Integer;
begin
 with TPrintDialog.Create(nil) do
 try
 if not Execute then
 Exit;
 finally
 Free;
 end;
 PageRect := Rect(0, 0, Printer.PageWidth, Printer.PageHeight);
 Printer.Title := 'Милиметровка';
 Printer.BeginDoc;
 try
 try
 with Printer.Canvas do
 begin
 SetMapMode(Handle, MM_HIMETRIC);
 DPtoLP(Handle, PageRect, 2);
 with PageRect do
 begin
 Inc(Left, 1000);
 Dec(Top, 1000);
 Dec(Right, 1000);
 Inc(Bottom, 1000);
 end;
 J := 0;
 I := PageRect.Left;
 while I < PageRect.Right do
 begin
 Pen.Width := GetPenWidth(J);
 MoveTo(I, PageRect.Top);
 LineTo(I, PageRect.Bottom);
 Inc(I, 100);
 Inc(J);
 end;
 J := 0;
 I := PageRect.Top;
 while I > PageRect.Bottom do
 begin
 Pen.Width := GetPenWidth(J);
 MoveTo(PageRect.Left, I);
 LineTo(PageRect.Right, I);
 Dec(I, 100);
 Inc(J);
 end;
 end;
 except
 Printer.Abort;
 raise;
 end;
 finally
 Printer.EndDoc;
 end;
end.
ID: 03263
Category:Принтер
Наполовину активное окно

=== Наполовину активное окно ===
Как сделать так, чтобы окно было неактивно? Вы скажите: "Ничего сложного. Нужно только свойство окна Enabled установить в false"... но, так как окно является владельцем компонентов, находящихся на нём, то и все компоненты станут неактивными! Но был найден способ избежать этого! 
private
 { Private declarations }
 procedure WMNCHitTest (var M: TWMNCHitTest); message wm_NCHitTest;
implementation
{$R *.DFM}
procedure TForm1.WMNCHitTest (var M:TWMNCHitTest);
begin
 if M.Result = htClient then
 M.Result := htCaption;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00426
Нарисовать линию, не используя функции LineTo

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Отображение текста с тегами форматирования
Рисует строку текста, содержащую теги форматирования, походие на теги HTML.
Поддерживаются следующие теги:
.. Полужирный
.. Наклонный
.. Подчёркнутый
.. Перечёркнутый
.. Увеличить размер шрифта на n единиц (по умолчанию 1)
.. Уменьшить шрифт на n единиц (по умолчанию 1)
.. Нижний индекс
.. Верхний индекс
Для правильного отображения внутри тегов и не должно располагаться других тегов
..
Установка параметров шрифта.
Размер шрифта указывается как для свойства TFont.Size, а не как в HTML.
В качестве цвета можно указывать либо константы clXXXX либо числа в формате #RRGGBB,
где RR GG и ВВ соответственно шестнадцатеричные значения 00..FF красной,
зелёной и синей составляющей, HTML цвета не поддерживаются. В параметре charset
указываются константы XXXX_CHARSET, например RUSSIAN_CHARSET или ANSI_CHARSET
Зависимости: Windows, SysUtils, Classes, Graphics, Dim
Автор: Dimka Maslov, mainbox@endimus.com, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 17 марта 2004 г.
***************************************************** }
unit HtDraw;
interface
uses Windows, SysUtils, Classes, Graphics, Dim;
type
 TTag = class;
 THtDraw = class(TObject)
 private
 FTag: TTag;
 FText: TString;
 procedure SetText(Value: TString);
 public
 function Draw(Canvas: TCanvas; X, Y: Integer): Integer;
 // Canvas - устройство для отображения текста.
 // в свойстве Canvas.Font задаются начальные параметры шрифта
 // X, Y - начальные координаты
 // Функция возвращает сумму X и ширины выведенного текста
 property Text: TString read FText write SetText;
 // Задаёт текст для отображения. В отличие от свойств компонентов,
 // присвоение значения этого свойства не приводит к автоматической
 // перерисовке. Необходимо вызывать метод Draw
 constructor Create(const AText: TString);
 destructor Destroy; override;
 end;
Полный текст модулей располагается по адресам:
* HtDraw: http://downloads.endimus.com/htdraw.zip
* Dim : http://downloads.endimus.com/dimpas.zip
Пример использования:
var
 HtDraw: THtDraw;
begin
 HtDraw :=
 THtDraw.Create('Test');
 try
 HtDraw.Draw(Canvas, 10, 10);
 finally
 HtDraw.Free;
 end;
end;
Author: Dimka Maslov
Source: http://delphibase.endimus.com
ID: 03736
Category:Графика
Category:Рисование
Настройка монитора

=== Настройка монитора ===
Иногда требуется, чтобы программа работала при чётко заданных параметрах монитора: разрешение, глубина цвета, частота обновления… Определить текущее разрешение просто, достаточно обратиться к объекту TScreen и посмотреть значения его полей Width и Height. А вот чтобы установить свои значения требуется обратиться к функции Api: ChangeDisplaySettings. Если мы хотим вернуть текущие настройки по завершении работы программы, то перед вызовом изменений надо запомнить эти настройки например таким образом: 
uses ShellApi;
var
 DefWidth, DefHeight, BPP: word;
procedure SaveSettings;
var
 DC: hDC;
begin
 DefWidth := Screen.Width;
 DefHeight := Screen.Height;
 DC := CreateDC('DISPLAY', nil, nil, nil);
 BPP := GetDeviceCaps(DC, BITSPIXEL);
end;
После этого можно устанавливать свои параметры. Для упрощения собственной жизни я написал небольшую процедуру, которой надо только передать желаемые параметры и она их либо установит, либо сообщит о невозможности их установки. 
procedure SetScreen(BPP: Byte; Width, Height, FR: Integer);
var
 D: TDevMode;
 h: HWND;
begin
 h := 0;
 D.dmDeviceName := 'DISPLAY';
 D.dmBitsPerPel := BPP;
 D.dmDisplayFrequency := FR;
 D.dmPelsWidth := Width;
 D.dmPelsHeight := Height;
 D.dmFields := DM_BITSPERPEL + DM_PELSWIDTH + DM_PELSHEIGHT + DM_DISPLAYFREQUENCY;
 D.dmSize := SizeOf(D);
 if ChangeDisplaySettings(D, CDS_TEST) = DISP_CHANGE_SUCCESSFUL then
 ChangeDisplaySettings(D, CDS_UPDATEREGISTRY)
 else
 MessageBox(h, 'This mode is not supported by your video.',
 'Failed to change mode', MB_ICONWarning);
end;
Вызывается так: SetScreen(глубина цвета, разрешение по горизонтали, разрешение по вертикали, частота в герцах); Например: 
SetScreen(16, 800, 600, 80); { 16 бит цвет, 800х600, 80Гц. }
При завершении программы для восстановления старых параметров вызываем эту процедуру с сохраненными ранее значениями: 
SetScreen(BPP, DefWidth, DefHeight, 80);
Я не стал здесь беспокоиться о сохранении/возвращении частоты обновления, а сразу установил 80Гц, но если кто желает, может сохранить и этот параметр при запуске 
DefFR := GetDeviceCaps(DC, VREFRESH);
и восстановить при закрытии программы: 
SetScreen(BPP, DefWidth, DefHeight, DefFR);
Пример применения этой возможности можно посмотреть в моей программе SDisplay, которая вешается в трей и позволяет быстро изменить параметры экрана. 
Source: Взято с http://delphiworld.narod.ru
ID: 01456
Настройка сетки графика по оси ординат

{ **** UBPFD *********** by kladovka.net.ru ****
>> Настройка оси
Настройка сетки графика по оси ординат. Имеет смысл при
передаче данных в другие пакеты, использующие графическое
представление данных (например, в Excel).
Зависимости: uses Chart, TeEngine, Math;
Автор: lookin
Copyright: lookin
Дата: 25 декабря 2002 г.
********************************************** }
// для использования в Delphi
procedure CalcAxis(NChart: TChart);
var
 step, ymx, ymn, rmx, rmn, raz: Double;
 i, n, m, d: Integer;
begin
 with NChart do
 begin
 ymx := -10000000000;
 ymn := 10000000000;
 m := 0;
 n := 0;
 for i := 0 to SeriesCount-1 do
 begin
 if Series[i].XValues.Count <> 0 then
 begin
 if Series[i].YValues.MaxValue > ymx then
 ymx := Series[i].YValues.MaxValue;
 if Series[i].YValues.MinValue < ymn then
 ymn := Series[i].YValues.MinValue;
 end;
 end;
 rmx := ymx;
 rmn := ymn;
 while ymn < 0 do
 begin
 ymn := ymn + 100;
 ymx := ymx + 100;
 Inc(m);
 end;
 raz := ymx - ymn;
 while raz < 100 do
 begin
 ymn := ymn * 10;
 ymx := ymx * 10;
 raz := ymx - ymn;
 Inc(n);
 end;
 ymx := Ceil(ymx);
 ymn := Floor(ymn);
 d := Trunc(ymx) div 100;
 ymx := (d + 1) * 100;
 d := Trunc(ymn) div 100;
 ymn := d * 100;
 raz := ymx - ymn;
 step := raz / 5;
 ymx := ymx / (Power(10, n)) - m * 100;
 ymn := ymn / (Power(10, n)) - m * 100;
 step := step / (Power(10, n));
 d := 0;
 for i := 1 to 5 do
 begin
 if (d = 0) and (ymn + step * i > rmx) then
 d := i;
 end;
 if d <> 0 then
 ymx := ymn + step * d;
 d := 0;
 for i := 1 to 5 do
 begin
 if (d = 0) and (ymn + step * i < rmn) then
 d := i;
 end;
 if d <> 0 then
 ymn := ymn + step * d;
 with LeftAxis do
 begin
 Automatic := False;
 Increment := Step;
 Minimum := -100000000000;
 Maximum := ymx;
 Minimum := ymn;
 end;
 end;
end;
// для использования в Excel в качестве макроса (Visual Basic)
Function SetAxisRange(CChart As Chart, ByRef AMax As Double, ByRef AMin As Double, ByRef AStep As Double)
Dim Step, RMax, RMin, Max, Min, Raz As Double
Dim I, J, N, M, d As Integer
 Max = -1000000
 Min = 1000000
 For I = 1 To CChart.SeriesCollection.Count
 ReDim VArray(UBound(CChart.SeriesCollection(I).Values))
 VArray = CChart.SeriesCollection(I).Values
 For J = 1 To UBound(VArray)
 If VArray(J) > Max Then Max = VArray(J)
 If VArray(J) < Min Then Min = VArray(J)
 Next J
 Next I
 RMax = Max
 RMin = Min
 N = 0
 M = 0
 If Max <> Min Then
 While Min < 0
 Min = Min + 100
 Max = Max + 100
 M = M + 1
 Wend
 Raz = Max - Min
 While Raz < 100
 Min = Min * 10
 Max = Max * 10
 Raz = Max - Min
 N = N + 1
 Wend
 Max = Int(Max) + 1
 Min = Int(Min)
 d = Max \ 100
 Max = (d + 1) * 100
 d = Min \ 100
 Min = d * 100
 Raz = Max - Min
 Step = Raz / 5
 AStep = Step / (10 ^ N)
 AMin = Min / (10 ^ N) - M * 100
 AMax = Max / (10 ^ N) - M * 100
 d = 0
 For I = 1 To 5
 If d = 0 Then
 If (AMin + AStep * I) > RMax Then d = I
 End If
 Next I
 If d <> 0 Then AMax = AMin + AStep * d
 d = 0
 For I = 1 To 5
 If d = 0 Then
 If (AMin + AStep * I) < RMin Then d = I
 End If
 Next I
 If d <> 0 Then AMin = AMin + AStep * d
 End If
End Function
Author: lookin
ID: 04250
Category:Алгоритмы
Category:Математика
Category:Диаграммы
Настройка системы безопасности DCOM сервера

Как я понял, основная проблема в DCOM, с которой сталкиваются разработчики - настройка системы безопасности. Далее описано, как были сделаны настройки безопасности у меня.
Создана группа, в которую включены пользователи, которым нужен доступ к данному DCOM серверу (назовем ее DCOM_DEBUG).
В DCOMCNFG: (это было добавлено и на сервере и на клиенте)
1. DefaultSecurity -> Default Access Permissions
 DCOM_DEBUG: Allow Access
 SYSTEM: Allow Access
 Everyone: Allow Access
2. DefaultSecurity -> Default Launch Permissions
 DCOM_DEBUG: Allow Launch
 SYSTEM: Allow Launch
 INTERACTIVE: Allow Launch
 Everyone: Allow Launch
3. DefaultSecurity -> Default Configuration Permissions
 SYSTEM: Full Control
 DCOM_DEBUG: Full Control
 Everyone: Full Control
Установка этих параметров необходима, по-моему, потому, что контекст безопасности интерфейса передаваемого на сервер для нотификации клиента берется из установок по умолчанию.
Только на сервере.
Установки параметров безопасности для объекта были установлены точно такие же, за исключением того, что Everyone включена не была. На вкладке Identity был выбран пользователь, от имени которого запускается COM сервер. Одна тонкость: у пользователя, от имени которого запускается COM сервер должно быть право "Log on as batch job", иначе сервер не запустится (это право было дано всей группе DCOM_DEBUG). Если выбрать Interactive User, то сервер не запустится, в том случае если пользователь делает Logoff. В случае с Launching User происходили какие-то невнятные проблемы (видимо это было связано со спецификой решаемой мной задачи - DCOM сервер с поддержкой множественных клиентских соединений).
Author: Алексей Вуколов
Source: http://www.delphikingdom.com
ID: 04327
Category:COM
Настройки всплывающих подсказок в DBNavigator

=== Настройки всплывающих подсказок в DBNavigator ===
procedure TForm1.Button1Click(Sender: TObject);
var
 ix: integer;
begin
 with DBNavigator1 do
 for ix := 0 to ControlCount - 1 do
 if Controls[ix] is TNavButton then
 with Controls[ix] as TNavButton do
 case index of
 nbFirst: Hint := 'Подсказка для кнопки First';
 nbPrior: Hint := 'Подсказка для кнопки Prior';
 nbNext: Hint := 'Подсказка для кнопки Next';
 nbLast: Hint := ;
 {......}
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03086
Category:Базы данных
Category:DBNavigator
Настройки принтера

Ниже приведены некоторые участки кода, позволяющие изменять настройки принтера. Тот код, который позволяет менять установки, позволяет также вам узнать принцип управления настройками. Смотри документацию по структурам ExtDeviceMode, TDEVMODE и escape функциям принтера GETSETPAPERBINS и GetDeviceCaps().
Один из путей изменения установок принтера перед печатью документа - изменение devicemode (режим устройства) принтера.
var
 Device: array[0..255] of Char;
 Driver: array[0..255] of Char;
 Port: array[0..255] of Char;
 hDMode: THandle;
 PDMode: PDEVMODE;
begin
 Printer.PrinterIndex := Printer.PrinterIndex;
 Printer.GetPrinter(Device, Driver, Port, hDMode);
 if hDMode <> 0 then
 begin
 pDMode := GlobalLock(hDMode);
 if pDMode <> nil then
 begin
 pDMode^.dmFields := pDMode^.dmFields or DM_COPIES;
 pDMode^.dmCopies := 5;
 GlobalUnlock(hDMode);
 end;
 GlobalFree(hDMode);
 end;
 Printer.PrinterIndex := Printer.PrinterIndex;
 Printer.BeginDoc;
 Printer.Canvas.TextOut(100, 100, 'Тест 1');
 Printer.EndDoc;
Другой путь - изменение TPrinter.Это позволит изменять установки во время работы.Вы можете изменять настройки МЕЖДУ страницами.
Чтобы сделать это:
Прежде чем поступит команда startpage()(см.модуль printers.pas в каталоге Source\VCL), вы можете передать принтеру следующий код:
DevMode.dmPaperSize := DMPAPER_LEGAL
{ сброс настроек }
Windows.ResetDc(dc, Devmode^);
Это также сбросит настройки, связанные с размером бумаги.Вы можете обратиться к описанию DEVMODE, чтобы узнать все доступные размеры бумаги.
Но это решение потребует перекомпиляции исходного кода vcl с добавлением пути к новому модулю(tools..options..library...libaray).Если вы все - таки на это решились, не забудьте после этого перезагрузить Delphi и помните, что после этого ваш исходный код становится несовместимым со стандартной версией Delphi.
Маленькое замечание...
При замене исходного принтера на другой помните, что размеры шрифтов не всегда могут правильно масштабироваться. Чтобы гарантировать соответствующий масштаб, установите свойство шрифта PixelsPerInch.
uses Printers;
var
 MyFile: TextFile;
begin
 AssignPrn(MyFile);
 Rewrite(MyFile);
 Printer.Canvas.Font.Name := 'Courier New';
 Printer.Canvas.Font.Style := [fsBold];
 Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
 Writeln(MyFile, 'Печатаем этот текст');
 System.CloseFile(MyFile);
end;
uses Printers;
begin
 Printer.BeginDoc;
 Printer.Canvas.Font.Name := 'Courier New';
 Printer.Canvas.Font.Style := [fsBold];
 Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);
 Printer.Canvas.Textout(10, 10, 'Печатаем этот текст');
 Printer.EndDoc;
end;
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03211
Category:Принтер
Нахождение угла между радиус вектором и осью OX

function angl(y, x: Extended): Extended; assembler;
asm
 fld y { СТЕК!!! Сначала у, потом х }
 fld x
 fpatan
end;
вывод ответа:
s := angl(0, 1) * 180 / pi; { Т.к возвращается угол в радианах }
WriteLn(s:0:0);
Author: Bink (Новиков Виктор) 
ID: 04103
Category:Алгоритмы
Category:Графика
Category:Геометрия
Не могу подсоединиться к IB из под web-сервера IIS, Netscape, Baikonur и др.

=== Не могу подсоединиться к IB из под web-сервера IIS, Netscape, Baikonur и др. ===
Если вы обращаетесь к IB из IIS, Baikonur и т.п. Web-серверов, то нужно использовать строку коннекта как для удаленного сервера, т.к. локальное подсоединение работать не будет. Например,
 server:c:\dir\data.gdb
или
 \\server\c:\data.gdb
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02893
Category:Базы данных
Category:Interbase
Не получается вставить в таблицу записи со строками на русском языке

=== Не получается вставить в таблицу записи со строками на русском языке ===
В Database Desktop поставьте правильный Language Driver у таблицы, например, Pdox ANSI Cyrr.
Это простой вопрос в том случае, если база уже создана на диске. Если мы создаем базу динамически из программы, то как потом поставить русский язык без Database Desktop'а?
Оказывается это не так просто. Я перерыл весь инет и так и не нашел. В итоге пришлось потрудится и получилась следующая функция:
{ Устанавливает русский LANGDRIVER для таблицы BDE (Paradox или dBASE)}
{ Таблица должна уже существовать на диске
 Если вы создаете таблицу динамически,
 не забудьте вызвать Table.CreateTable }
procedure SetTableRussianLanguage(Table: TTable);
var
 Props: CURProps;
 hDb: hDBIDb;
 TableDesc: CRTblDesc;
 OptDesc: FLDDesc;
 OptData: array [0..250] of Char;
 S: string;
const // Define propertly table type & codepage from list below
 LDName = 'ancyrr'; // Paradox ANSI Cyrillic
 // LDName = 'cyrr'; // Paradox Cyrr 866
 // LDName = 'DB866ru0'; // dBASE RUS cp866
begin
 // Get handle (if table still not opened)
 Table.Open;
 // Get the table properties to determine table type...
 Check(DbiGetCursorProps(Table.Handle, Props));
 // Blank out the structure...
 FillChar(TableDesc, sizeof(TableDesc), 0);
 FillChar(OptDesc, SizeOf(OptDesc), #0);
 // Get the database handle from the table's cursor handle...
 Check( DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE,
 hDBIObj(hDb)));
 { If table name contain cyrillic or other native character,
 convert name to OEM }
 SetLength(S, Length(Table.TableName));
 CharToOEM(PChar(Table.TableName), @S[1]);
 // Put the table name in the table descriptor...
 StrPCopy(TableDesc.szTblName, S{Table.TableName});
 // Put the table type in the table descriptor...
 StrPCopy(TableDesc.szTblType, Props.szTableType);
 // Set the Pack option in the table descriptor to TRUE...
 StrCopy(OptDesc.szName, 'LANGDRIVER');
 OptDesc.iLen:=Length(LDName)+1;
 TableDesc.iOptParams:=1;
 TableDesc.pfldOptParams:=@OptDesc;
 TableDesc.pOptData:=@OptData;
 StrPCopy(OptData, LDName);
 // Close the table so the restructure can complete...
 Table.Close;
 // Call DbiDoRestructure...
 Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02497
Не работает кнопка Enter в WebBrowser

Html страницы, отображаемые в TWebBrowser часто имеют кнопки "Submit", и нажатие <Enter> не воспринимается непосредственно этой кнопкой.
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, OleCtrls, SHDocVw_TLB, ActiveX, StdCtrls;
type
 TForm1 = class(TForm)
 WebBrowser1: TWebBrowser;
 Button1: TButton;
 Button2: TButton;
 procedure FormDestroy(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 FOleInPlaceActiveObject: IOleInPlaceActiveObject;
 procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormDestroy(Sender: TObject);
begin
 FOleInPlaceActiveObject := nil;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMessage := MsgHandler;
end;
procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
var
 iOIPAO: IOleInPlaceActiveObject;
 Dispatch: IDispatch;
begin
 if not Assigned(WebBrowser1) then
 begin
 Handled := False;
 Exit;
 end;
 Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True);
 if (Handled) and (not WebBrowser1.Busy) then
 begin
 if FOleInPlaceActiveObject = nil then
 begin
 Dispatch := WebBrowser1.Application;
 if Dispatch <> nil then
 begin
 Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
 if iOIPAO <> nil then
 FOleInPlaceActiveObject := iOIPAO;
 end;
 end;
 if FOleInPlaceActiveObject <> nil then
 if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
 ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT)) then
 //nothing - do not pass on Backspace, Left or Right arrows
 else
 FOleInPlaceActiveObject.TranslateAccelerator(Msg);
 end;
end;
Author: Song
Source: http://forum.sources.ru
ID: 03473
Category:Связь
Category:WebBrowser
Не сохраняются изменения в базе Paradox

=== Не сохраняются изменения в базе Paradox ===
Где-нибудь при закрытии главной формы выполните нижеследующие куски кода:
при открытой таблице:
Table.FlushBuffers;
Для прочих:
Table.Open;
Check(dbiSaveChanges(Table.Handle));
Table.Close;
Чтобы сбросить кэш, можно еще после этого сделать:
asm
 mov ah, $0D
 int $21
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02953
Category:Базы данных
Category:Paradox