nyuuzyou/wikis huggingface dataset:
Смена свойств приложения, открываемого, по умолчанию в среде при её запске

=== Смена свойств приложения, открываемого, по умолчанию в среде при её запске ===
Большинство стандартных темплейтов зашиты в delphide70.bpl (70 - версия), остальные - в каталоге Objrepos. Описаны же последние в файле bin\delphi32.dro. Т.о:
1. Добавляем в "delphi32.dro" строки:
 [C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\MyApp]
 Type=ProjectTemplate
 Page=Projects
 Name=My Application
 Description=This is my application template
 Author=Eugene
 Icon=C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\MyApp.ico
 DefaultProject=1
 Designer=dfm
(для темплейтов формы Type=FormTemplate, DefaultMainForm=0/1, DefaultNewForm=0/1)
2. Размещаем нашу темплейт-прогу в каталоге "C:\Program Files\Lang\Delphi7\ObjRepos\MyApp\" и называем её "MyApp.dpr".
3. Жмём "File/New/Application" (т.к. у нас DefaultProject=1), либо заходим во вкладку "Projects", а затем кликаем два раза по "My Application".
4. Радуемся! 
Author: Jin X
Source: http://forum.sources.ru
ID: 00052
Сменить цвет выделения в StringGrid

=== Сменить цвет выделения в StringGrid ===
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; 
 Rect: TRect; State: TGridDrawState); 
const 
 SelectedColor = Clblue; 
begin 
 if (state = [gdSelected]) then 
 with TStringGrid(Sender), Canvas do 
 begin 
 Brush.Color := SelectedColor; 
 FillRect(Rect); 
 TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[aCol, aRow]); 
 end; 
end;
Source: http://delphiworld.narod.ru/
ID: 01055
Смешать два изображения

WEB-сайт: http://v-isa.narod.ru
Модуль MyGraph.pas включает в себя только одну процедуру, позволяющую смешать 2 изображения. Такая функция может быть полезна для получения различных эффектов, а также для нанесения на изображение "водяных знаков".
unit MyGraph;
interface
uses Graphics;
procedure MixBMP(BM1, BM2: TBitMap; var BM: TBitMap);
implementation
procedure MixBMP(BM1, BM2: TBitMap; var BM: TBitMap);
var
 I, J: Integer;
 MinW, MinH: Integer;
begin
 BM := TBitMap.Create;
 if BM1.Width < BM2.Width then
 MinW := BM1.Width
 else
 MinW := BM2.Width;
 if BM1.Height < BM2.Height then
 MinH := BM1.Height
 else
 MinH := BM2.Height;
 BM.Width := MinW;
 BM.Height := MinH;
 for I := 0 to MinW do
 for J := 0 to MinH do
 if (Odd(I) and Odd(J)) or ((not (Odd(I))) and (not (Odd(J)))) then
 BM.Canvas.Pixels[I, J] := BM1.Canvas.Pixels[I, J]
 else
 BM.Canvas.Pixels[I, J] := BM2.Canvas.Pixels[I, J];
end;
begin
end.
Author: Вадим Исаенко
Source: http://delphiworld.narod.ru/
ID: 03904
Category:Графика
Category:Bitmap
Смешиваем два цвета.

Самый простой способ смешать два цвета c1 и c2, это вычислить средние значения rgb-значений. Данный пример не отличается особой быстротой, поэтому если Вам нужно быстро смешивать цвета, то придётся пошевелить мозгами...
function GetMixColor(c1, c2: TColor): TColor;
begin
 // вычисляем средние значения Красного, Синего и Зелёного значений
 // цветов c1 и c2:
 Result := RGB((GetRValue(c1) + GetRValue(c2)) div 2,
 (GetGValue(c1) + GetGValue(c2)) div 2,
 (GetBValue(c1) + GetBValue(c2)) div 2);
end;
Source: http://forum.sources.ru
ID: 03679
Category:Графика
Category:Цвета и палитры
Смешивание цветов рисунка с другим цветом

**** UBPFD *********** by delphibase.endimus.com ****
>> Смешивание цветов рисунка с другим цветом
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 5 июня 2002 г.
***************************************************** }
procedure Mixer(Bitmap: TBitmap; Value: Byte; Color: TColor);
 function BLimit(B: Integer): Byte;
 begin
 if B < 0 then
 Result := 0
 else if B > 255 then
 Result := 255
 else
 Result := B;
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y: Word;
 Dest: pRGB;
 DR, DG, DB, D: Double;
begin
 D := Value / 200;
 DR := Lo(Color) * (1.275 - D);
 DG := Lo(Color shr 8) * (1.275 - D);
 DB := Lo((Color shr 8) shr 8) * (1.275 - D);
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 with Dest^ do
 begin
 B := BLimit(Round(B * D + DB));
 G := BLimit(Round(G * D + DG));
 R := BLimit(Round(R * D + DR));
 end;
 Inc(Dest);
 end;
 end;
 { Неоптимизированный вариант.
 Value - процент цвета рисунка от конечного цвета,
 (255-Value) - процент цвета Color от конечного цвета,
 где 255 - это 100%;
 Новый цвет получается путём нахождения
 среднеарифметического значения каждого компонента
 цвета в точке (x, y) и цвета Color
 после процентного преобразования.
 DR := Lo(Color); // извлечение красного
 DG := Lo(Color shr 8); // извлечение зелёного
 DB := Lo((Color shr 8) shr 8); // извлечение синего
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 with Dest^ do
 begin
 R := BLimit(Round((R/100 * Value + DR/100 * (255-Value)) / 2));
 G := BLimit(Round((G/100 * Value + DG/100 * (255-Value)) / 2));
 B := BLimit(Round((B/100 * Value + DB/100 * (255-Value)) / 2));
 end;
 Inc(Dest);
 end;
 end; }
end;
// Пример использования:
Mixer(FBitmap, 120, clRed);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03870
Category:Графика
Category:Bitmap
Category:Цвета и палитры
Снимок рабочего стола

=== Снимок рабочего стола ===
type
 TForm1 = class(TForm)
 public
 { Public declarations }
 procedure GrabScreen;
 end;
implementation
{$R *.DFM}
procedure TForm1.GrabScreen;
var
 DeskTopDC: HDc;
 DeskTopCanvas: TCanvas;
 DeskTopRect: TRect;
begin
 DeskTopDC := GetWindowDC(GetDeskTopWindow);
 DeskTopCanvas := TCanvas.Create;
 DeskTopCanvas.Handle := DeskTopDC;
 DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
 Form1.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
 ReleaseDC(GetDeskTopWindow, DeskTopDC);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 GrabScreen;
end;
Source: http://delphiworld.narod.ru/
ID: 01839
Событие Key Press и курсорные клавиши в TMemo

=== Событие Key Press и курсорные клавиши в TMemo ===
Мне необходимо обновлять текущую строку в во время перемещения по ним с помощью курсорных клавиш. 
Вам повезло. Совсем недавно мне пришлось помучиться с этой задачкой. Я переместил функции в отдельный модуль. Для тестирования кода создайте пустую форму с одним компонентом Tmemo. 
Вам потребуется перехватывать ряд событий. В приведенном ниже коде я создал обработчиков всех возможных для данной операции событий, выберите себе необходимые сами. Некоторые из событий могут иметь общий обработчик. 
Данный пример отображает в заголовке текущие координаты курсора (столбец, строка). 
Я не стал отображать координаты, когда текст выбран, поскольку не был уверен как этим оперировать без рассогласования... 
Сообщайте мне о любых возникающих проблемах, но я уверен что это должно работать как положено.
unit Unit1;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Memo1: TMemo;
 procedure Memo1Change(Sender: TObject);
 procedure Memo1Click(Sender: TObject);
 procedure Memo1Enter(Sender: TObject);
 procedure Memo1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
 procedure Memo1KeyUp(Sender: TObject; var Key: Word;
 Shift: TShiftState);
 procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 private
 { Private declarations }
 function GetLineIndex: Word;
 function GetStrInsertIndex: Word;
 procedure GetCursorCoord;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.GetLineIndex: Word;
begin
 Result := SendMessage(Memo1.handle, EM_LINEFROMCHAR, memo1.selstart, 0);
end;
function TForm1.GetStrInsertIndex: word;
begin
 GetStrInsertIndex :=
 memo1.Selstart - SendMessage(Memo1.handle, EM_LINEINDEX, GetLineIndex, 0)
end;
procedure TForm1.GetCursorCoord;
var
 LineIndex: word;
 LineChar: byte;
 SelSt: word;
begin
 SelSt := Memo1.selstart;
 LineIndex := GetLineIndex;
 Linechar := GetStrInsertIndex;
 if Memo1.seltext > then
 Caption := 'Выбранный текст'
 else
 Caption := 'Колонка ' + inttostr(LineChar + 1) + ' , ' +
 'Строка ' + inttostr(Lineindex + 1);
end;
procedure TForm1.Memo1Change(Sender: TObject);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1Click(Sender: TObject);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1Enter(Sender: TObject);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 GetCursorCoord;
end;
procedure TForm1.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 GetCursorCoord;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01010
События KeyPress и KeyDown не вызываются для Tab - как определить ее нажатие

=== События KeyPress и KeyDown не вызываются для Tab - как определить ее нажатие ===
type
 TForm1 = class(TForm)
 private
 procedure CMDialogKey(var msg: TCMDialogKey); message CM_DIALOGKEY;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
 if msg.Charcode <> VK_TAB then
 inherited;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if Key = VK_TAB then
 Form1.Caption := 'Tab Key Down!';
end;
Source: http://delphiworld.narod.ru/
ID: 01187
Соглашения о вызовах

=== Соглашения о вызовах ===
При объявлении процедур и функций в динамических библиотеках используются различные соглашения о вызовах. Дело в том, что различные языки программирования по-разному реализуют передачу параметров в процедуру (через стек или регистры). Порядок следования параметров в стеке как раз определяется соглашением о вызовах. 
Стандартный вызов в языках C++ и Object Pascal различается, но набор директив смены типа вызова позволяет обеспечить любую реализацию. 
Во всех соглашениях о вызовах вызывающая процедура помещает параметры в стек. В зависимости от типа соглашения, очистка стека осуществляется вызывающей или вызываемой процедурой. 
Если очистка стека выполняется вызывающей процедурой, то она успевает забрать из него возвращаемые значения. 
Если очистка стека осуществляется вызываемой процедурой, то перед этим она помещает возвращаемые значения во временную область памяти. 
Помимо рассмотренных ниже директив имеются еще три типа вызовов, которые не используются и сохранены для обеспечения обратной совместимости. Это директивы near, far, export. 
==== Директива register ====
Эта директива используется по умолчанию. Поэтому нет необходимости добавлять ключевое слово register после объявления функции. Вызов такого типа называется быстрым (fast call). В нем используются три расширенных регистра процессора, в которые помещаются переменные длиной не более 32-х разрядов и указатели. Остальные параметры помещаются в стек слева направо. После использования стек очищается вызываемой процедурой.
==== Директива pascal ====
Реализует вызовы в стиле языка Pascal. За очистку стека отвечает вызываемая процедура. Параметры помещаются в стек слева направо. Этот способ вызова является очень быстрым, но не поддерживает переменное число параметров. Используется для обеспечения обратной совместимости. 
==== Директива stdcall ====
Параметры помещаются в стек слева направо. Очистка стека осуществляется вызываемой процедурой. Этот вызов обеспечивает обработку фиксированного числа параметров. 
==== Директива cdecl ====
Реализует вызовы в стиле языка С. Параметры в стек помещаются справа налево. Очистка стека осуществляется вызывающей процедурой. Такие вызовы обеспечивают обслуживание переменного числа параметров, но скорость обработки меньше, чем в вызовах при реализации директивы pascal. 
Эта директива в основном применяется для обращения к динамическим библиотекам, использующим соглашения о вызовах в стиле языка С. Использование директивы cdecl для библиотек Delphi не вызовет ошибку компиляции, но переменное число параметров не обеспечит. 
==== Директива safecall ====
Параметры помещаются в стек справа налево. Очистка стека осуществляется вызываемой процедурой. Используется в СОМ и основанных на ней технологиях. 
ID: 01993
Category:Справочники
Создание/пересоздание индекса

=== Создание/пересоздание индекса ===
DbiRegenIndexes(Table1.Handle); { Регенерация всех индексов }
// create index (зависит от существования выражения)
if (( Pos('(', cTagExp) + Pos('+', cTagExp) ) > 0 ) then
 Table1.AddIndex(cTagName, cTagExp, [ixExpression]) // <- ixExpression - _литерал_
else
 Table1.AddIndex(cTagName, cTagExp, []);
Source: Взято с http://delphiworld.narod.ru
ID: 02709
Создание DBExpress-Connection в Run-Time

=== Создание DBExpress-Connection в Run-Time ===
procedure TVCLScanner.PostUser(const Email, FirstName, LastName: WideString);
var
 Connection: TSQLConnection;
 DataSet: TSQLDataSet;
begin
 Connection := TSQLConnection.Create(nil);
 with Connection do
 begin
 ConnectionName := 'VCLScanner';
 DriverName := 'INTERBASE';
 LibraryName := 'dbexpint.dll';
 VendorLib := 'GDS32.DLL';
 GetDriverFunc := 'getSQLDriverINTERBASE';
 Params.Add('User_Name=SYSDBA');
 Params.Add('Password=masterkey');
 Params.Add('Database=milo2:D:\frank\webservices\umlbank.gdb');
 LoginPrompt := False;
 Open;
 end;
 DataSet := TSQLDataSet.Create(nil);
 with DataSet do
 begin
 SQLConnection := Connection;
 CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")',
 [Email, FirstN, LastN]);
 try
 ExecSQL;
 except
 end;
 end;
 Connection.Close;
 DataSet.Free;
 Connection.Free;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02687
Создание PolyPolygon используя массив точек?

Polygon - метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.
procedure TForm1.Button1Click(Sender: TObject);
var
 ptArray: array[0..9] of TPoint;
 PtCounts: array[0..1] of Integer;
begin
 PtArray[0] := Point(0, 0);
 PtArray[1] := Point(0, 100);
 PtArray[2] := Point(100, 100);
 PtArray[3] := Point(100, 0);
 PtArray[4] := Point(0, 0);
 PtCounts[0] := 5;
 PtArray[5] := Point(25, 25);
 PtArray[6] := Point(25, 75);
 PtArray[7] := Point(75, 75);
 PtArray[8] := Point(75, 25);
 PtArray[9] := Point(25, 25);
 PtCounts[1] := 5;
 PolyPolygon(Form1.Canvas.Handle, PtArray, PtCounts, 2);
end;
ID: 03911
Category:Графика
Category:Рисование
Category:WinAPI
Создание QR-кода с логотипом

- Я впервые попробовал Laz barcodes для создания QR-кодов. Это реально просто. А теперь хочу вставить логотип внутрь QR-кода. Это возможно?
- Если в центре хватит пустого места и QR-код не слишком избыточен, то вполне.
Код по запросу в OpenAI:
 write a qrcode generator in object pascal that allows a logo in the middle.
uses
 Classes, Graphics, QRCode;
 
type
 TQRCodeGenerator = class
 private
 FQRCode: TQRCode;
 FLogo: TBitmap;
 FImage: TBitmap;
 procedure CreateQRCode;
 public
 constructor Create;
 destructor Destroy; override;
 procedure GenerateQRCode(const AText: string; const ALogo: TBitmap);
 property Image: TBitmap read FImage;
 end;
 
constructor TQRCodeGenerator.Create;
begin
 inherited;
 FQRCode := TQRCode.Create;
 FImage := TBitmap.Create;
end;
 
destructor TQRCodeGenerator.Destroy;
begin
 FImage.Free;
 FQRCode.Free;
 FLogo.Free;
 inherited;
end;
 
procedure TQRCodeGenerator.CreateQRCode;
var
 LSize, LOffset: Integer;
 LData: TBitmapData;
begin
 FQRCode.CompactMode := True;
 FQRCode.Encoding := qrenAuto;
 FQRCode.Data := FQRCode.Encode(FQRCode.Data);
 FQRCode.Draw(FImage, 0, 0);
 
 // Draw the logo
 if Assigned(FLogo) then
 begin
 FImage.Map(TMapAccess.ReadWrite, LData);
 try
 LSize := FQRCode.GetSize;
 LOffset := (LSize div 2) - (FLogo.Width div 2);
 FLogo.DrawTo(LData, LOffset, LOffset);
 finally
 FImage.Unmap(LData);
 end;
 end;
end;
 
procedure TQRCodeGenerator.GenerateQRCode(const AText: string; const ALogo: TBitmap);
begin
 FQRCode.Data := AText;
 FLogo := ALogo;
 CreateQRCode;
end;
 
end.
Не проверялось!
Возможно, пригодится модуль от Xor-El. Его код качественный и с поддержкой логотипов.
* https://github.com/Xor-el/QRCodeGenLib4Pascal
Source: https://forum.lazarus.freepascal.org/index.php/topic,61789.msg466007/topicseen.html#new
Создание RES-файла с помощью BRCC.EXE

=== Создание RES-файла с помощью BRCC.EXE ===
Данный метод обходит проблемы, связанные с Image Editor.
В каталоге \DELPHI\BIN имеется утилита командной строки, названная BRCC.EXE, позволяющая создавать из файлов, содержащих изображения/иконки, RES-файлы, в обход Image Editor. (Тем не менее, Image Editor хорошо работает при создании или редактировании файлов с изображениями или курсорами. Проблемой был импорт.)
Resource File Compiler описан в справке Windows API help в главе Windows Tools (где вы также можете прочесть о RC.EXE как о BRCC.EXE!). Это сэкономит вам какое-то время!
Сначала, используя Блокнот, создайте файл определения ресурса (Resource Definition) (текстовый) с именем, скажем, MYRES.RC (с обязательным расширением RC). Разместите, каждую на отдельной строке, ссылки на изображения, иконки, и т.п., которые вы хотели бы включить в RES-файл, например:
 BITMAP1 BITMAP <путь><имя файла>
 BITMAP2 BITMAP <путь><имя файла>
 CURSOR1 CURSOR <путь><имя файла>
 ICON1 ICON <путь><имя файла>
Затем (это не обязательно, но сохранит массу времени, особенно если вы экспериментируете), в том же каталоге создайте BAT-Файл, вызывающий программу для компиляции каждого ресурса:
 "C:\DELPHI\BIN\BRCC/R %1"
Назовите его, скажем, MAKERES.BAT.
Перейдите в DOS и в каталоге проекта введите "MAKERES MYRES.RC".
Заданные ресурсы будут скомпилированы в новый файл MYRES.RES, который может быть прилинкован к вашему проекту как и прежде. Используйте Image Editor для проверки и редактирования.
Author: Bob Villiers
ID: 02168
Создание UDF для InterBase

=== Создание UDF для InterBase ===
library nikelutils
uses SysUtils, Classes;
function MaxInt(var Int1, Int2: Integer): Integer; far cdecl export;
begin
 if (Int1 > Int2) then
 Result := Int1
 else
 Result := Int2;
end;
function MinInt(var Int1, Int2: Integer): Integer; far cdecl export;
begin
 if (Int1 < Int2) then
 Result := Int1
 else
 Result := Int2;
end;
exports
 MaxInt;
 MinInt;
begin
end.
А это пишем в базе:
DECLARE EXTERNAL FUNCTION MAXINT INTEGER, INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT "MaxInt" MODULE_NAME "nikelutils.dll";
DECLARE EXTERNAL FUNCTION MININT INTEGER, INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT "MinInt" MODULE_NAME "nikelutils.dll";
Source: Взято с http://delphiworld.narod.ru
ID: 02924
Category:Базы данных
Category:Interbase
Создание автоинкрементного поля SQL запросом?

=== Создание автоинкрементного поля SQL запросом? ===
{
 Lets say that we wish to create a fallawing number (Autoincrese) of an item,
 without using the AutoIncrese filed.
 This is usfull when for example there is more users from the same IP that log
 in or any other things that you wish.
 This example will show you how to do it with some checking of filled data,
 but it can be done anyway you wish.
 You need a Table with at least 2 fileds with number casting, and a TQUERY component.
}
function TForm1.GetNextNumber : integer;
begin
 qryMain.Active := False;
 qryMain.SQL.Clear;
 qryMain.SQL.Add('SELECT Max(FieldToIncrease) FROM tblMain WHERE (Cheking >=1);');
 qryMain.Active := True; // We executed the query
 if qryMain.RecordCount >= 0 then
 Result := qryMain.FieldByName('FieldToIncrese').AsInteger + 1;
 else
 Result := 1;
end;
...
procedure TForm1.SetNextNumber;
begin
 // You must first see if the table is in insert/update mode before using this procedure.
 tblMain.FieldByName('FieldToIncrese').AsInteger := GetNextNumber;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02620
Создание базы данных в run-time с ZEOS?

=== Создание базы данных в run-time с ZEOS? ===
Примечание от Vit: Zeos - популярный бесплатный пакет доступа к базам данных, подробности см. на sourceforge.net
{
 This unit creates a database on a Interbase-Server at run-time.
 The IBConsole is no longer needed.
 You can execute an SQL script to create tables.
 Try it out!
}
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ZTransact, ZIbSqlTr, DB, ZQuery, ZIbSqlQuery,
 ZConnect, ZIbSqlCon;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Memo1: TMemo;
 Button2: TButton;
 ZIbSqlQuery1: TZIbSqlQuery;
 ZIbSqlTransact1: TZIbSqlTransact;
 ZIbSqlDatabase1: TZIbSqlDatabase;
 Button3: TButton;
 procedure Button1Click(Sender: TObject); // Caption/
 procedure Button2Click(Sender: TObject); // Caption/
 procedure Button3Click(Sender: TObject); // Caption/
 private
 public
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
// Creating the database
procedure TForm1.Button1Click(Sender: TObject);
begin
 ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
 ZIbSqlDatabase1.Host := 'testserver';
 ZIbSqlDatabase1.Password := 'masterkey';
 ZIbSqlDatabase1.Login := 'SYSDBA';
 ZIbSqlDatabase1.CreateDatabase();
end;
// Execute the SQL-Script in the memo
procedure TForm1.Button2Click(Sender: TObject);
begin
 ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
 ZIbSqlDatabase1.Host := 'testserver';
 ZIbSqlDatabase1.Password := 'masterkey';
 ZIbSqlDatabase1.Login := 'SYSDBA';
 ZIbSqlQuery1.SQL.Clear;
 ZIbSqlQuery1.SQL.AddStrings(memo1.Lines);
 ZIbSqlQuery1.ExecSQL;
end;
// Deleted the database
procedure TForm1.Button3Click(Sender: TObject);
begin
 ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
 ZIbSqlDatabase1.Host := 'testserver';
 ZIbSqlDatabase1.Password := 'masterkey';
 ZIbSqlDatabase1.Login := 'SYSDBA';
 ZIbSqlDatabase1.DropDatabase;
end;
end.
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02412
Создание банковского ключа

function CheckCtrlKey(ANLs: string; AMfo: Real): Boolean;
const
 { 12345678901234567890xxx }
 msk: string[28] = '71371371371371371371713';
var
 i: Byte;
 s: Integer;
 nls: string[28];
 bic: string[10];
begin
 bic := LeftPad(RealToStr(AMfo, 9, 0), 9);
 if bic[7] <> '0' then { < =Простая проверка -- это РКЦ? }
 { не учитывает ГРКЦ }
 nls := bic[7] + bic[8] + bic[9]
 else
 nls := '0' + bic[5] + bic[6]; { РКЦ }
 nls := ANLs + nls;
 s := 0;
 for i := 1 to 23 do
 s := s + (((Byte(nls[i])-48) * (Byte(msk[i])-48)) mod 10);
 s := s mod 10;
 Result := (s = 0);
end;
Source: http://delphiworld.narod.ru/
ID: 04052
Category:Алгоритмы
Category:Безопасность