nyuuzyou/wikis huggingface dataset:
Преобразование числа в двоичную запись

Для преобразования числа в двоичную запись удобно использовать функции shl и and.
Эта функция преобразует число в строку из единиц и нулей. Количество цифр определяется параметром Digits.
function IntToBin(Value: Integer; Digits: Integer): string;
var
 i: integer;
begin
 Result := ;
 for i := 0 to Digits - 1 do
 begin
 if Value and (1 shl i) > 0 then
 Result := '1' + Result
 else
 Result := '0' + Result;
 end;
end;
Вот пример использования этой функции:
procedure TForm1.Edit1Change(Sender: TObject);
begin
 Form1.Caption := IntToBin(StrToIntDef(Edit1.Text, 0), 128);
end;
Source: http://blackman.wp-club.net/
ID: 04055
Category:Алгоритмы
Category:Математика
Преобразовать Персидскую дату в дату по Грегорианскому календарю

=== Преобразовать Персидскую дату в дату по Грегорианскому календарю ===
function Persia_to_Ger_date(aa: ShortString; ResultKind: Byte = 0): ShortString;
 function TrueTo1(co: Boolean): Integer;
 begin
 if co then TrueTo1 := 1
 else
 TrueTo1 := 0;
 end;
 const
 Conm_mons: array[0..11] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);
 LeapYearSh: array[0..4] of Integer = (1375,1379,1383,1387,1391);
 LeapYearMi: array[0..4] of Integer = (1996,2000,2004,2008,2012);
 monthes: array[0..11] of ShortString = ('Jan', 'Feb', 'Mar', 'Apr',
 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
 type
 date = record
 da_day, da_mon, da_year: Integer;
 end;
 var
 m_mons: array[0..11] of BYTE;
 LastDayCountSh, LastDayCountMi: integer;
 a, b: date;
 sYY, sMM, sDD: ShortString;
 I: Integer;
 begin
 for I := Low(Conm_mons) to High(Conm_mons) do
 m_mons[I] := Conm_mons[I];
 a.da_day := StrToNum(Copy(aa, DayPosInDate, DayLen));
 a.da_mon := StrToNum(Copy(aa, MonthPosInDate, MonthLen));
 a.da_year := StrToNum(Copy(aa, YearPosInDate, YearLen));
 b.da_year := a.da_year + 621;
 Inc(b.da_year, TrueTo1(((a.da_mon > 10) or ((a.da_mon = 10) and (a.da_day >= 12)))
 or ((LeapYearSh[(a.da_year - 1374) div 4] <> a.da_year) and
 ((a.da_mon = 10) and (a.da_day = 11)))));
 Inc(m_mons[1], TrueTo1(LeapYearMi[(b.da_year - 1996) div 4] = b.da_year));
 if (a.da_mon <= 7) then LastDayCountSh := ((a.da_mon - 1) * 31 + a.da_day)
 else
 LastDayCountSh := (186 + (a.da_mon - 7) * 30 + a.da_day);
 if (b.da_year = (a.da_year + 622)) then LastDayCountMi :=
 LastDayCountSh - 286 - TrueTo1(LeapYearSh[(a.da_year - 1375) div 4] = a.da_year)
 else
 LastDayCountMi := (LastDayCountSh + 79);
 b.da_day := LastDayCountMi;
 b.da_mon := 0;
 while (LastDayCountMi > m_mons[b.da_mon]) do
 begin
 Dec(LastDayCountMi, m_mons[b.da_mon]);
 Inc(b.da_mon);
 b.da_day := LastDayCountMi;
 end;
 Inc(b.da_mon);
 if b.da_year < 1000 then sYY := sYY + '0';
 if b.da_year < 100 then sYY := sYY + '0';
 if b.da_year < 10 then sYY := sYY + '0';
 sYY := sYY + IntToStr(b.da_year);
 if b.da_mon < 10 then sMM := sMM + '0';
 sMM := sMM + IntToStr(b.da_mon);
 if b.da_day < 10 then sDD := sDD + '0';
 sDD := sDD + IntToStr(b.da_day);
 case ResultKind of
 0: Persia_to_Ger_date := sYY + '/' + sMM + '/' + sDD;
 1: Persia_to_Ger_date := sYY + ' ' + monthes[b.da_mon - 1] + ' ' + sDD;
 end;
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00737
Преобразовать первую букву каждого слова к верхнему регистру в TEdit

=== Преобразовать первую букву каждого слова к верхнему регистру в TEdit ===
procedure TForm1.Edit1Change(Sender: TObject);
var
 OldChange: TNotifyEvent;
 OldStart: Integer;
begin
 with (Sender as TEdit) do
 begin
 OldChange := OnChange;
 OnChange := nil;
 OldStart := SelStart;
 if ((SelStart > 0) and (Text[SelStart - 1] = ' ')) or (SelStart = 1) then
 begin
 SelStart := SelStart - 1;
 SelLength := 1;
 SelText := AnsiUpperCase(SelText);
 end;
 OnChange := OldChange;
 SelStart := OldStart;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00975
----
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 with Sender as TEdit do
 if (Text = ) or (Text[SelStart] = ' ')
 or (SelLength = Length(Text)) then
 if Key in ['a'..'z'] then
 Key := UpCase(Key);
end;
Source: http://delphiworld.narod.ru/
ID: 00977
Преобразуем доменное имя в IP адрес

Описывается функция, которая показывает, как вычислить IP адрес компьютера в интернете по его доменному имени.
Совместимость: Delphi 3.x (или выше)
Объявляем Winsock, для использования в функции
function HostToIP(Name: string; var Ip: string): Boolean;
var
 wsdata: TWSAData;
 hostName: array [0..255] of Char;
 hostEnt: PHostEnt;
 addr: PChar;
begin
 Result := False;
 WSAStartup($0101, wsdata);
 try
 GetHostName(hostName, SizeOf(hostName));
 StrPCopy(hostName, Name);
 hostEnt := GetHostByName(hostName);
 if Assigned(hostEnt) then
 begin
 if Assigned(hostEnt^.h_addr_list) then
 begin
 addr := hostEnt^.h_addr_list^;
 if Assigned(addr) then
 begin
 Ip := Format('%d.%d.%d.%d', [Byte(addr[0]), Byte(addr[1]), Byte(addr[2]), Byte(addr[3])]);
 Result := True;
 end;
 end;
 end;
 finally
 WSACleanup();
 end
end;
Вы можете разместить на форме EditBox, Кнопку и Label и добавить к кнопке следующий обработчик события OnClick:
procedure TForm1.Button1Click(Sender: TObject);
var
 IP: string;
begin
 if HostToIp(Edit1.Text, IP) then
 Label1.Caption := IP;
end;
Author: Lutfi Baran
Author: neutrino 
Source: http://forum.vingrad.ru
ID: 03344
ID: 03348
----
А вот какой способ предложен для нахождения собственного IP рассылкой мастеров дельфи http://Subscribe.Ru/catalog/comp.soft.prog.mdelphi():
var
 WSAData: TWSAData;
 SockAddrIn: TSockAddrIn;
 Host: PHostEnt;
 // Эти переменные объявлены в Winsock.pas
begin
 if WSAStartup($101, WSAData) = 0 then
 begin
 Host := GetHostByName(@Localname[1]);
 if Host <> nil then
 begin
 SockAddrIn.sin_addr.S_addr := LongInt(plongint(Host^.h_addr_list^)^);
 LocalIP := inet_ntoa(SockAddrIn.sin_addr);
 end;
 WSACleanUp;
 end;
end;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 03345
Category:Связь
Прерывание работы принтера

При вызове Printer.Abort должен вызываться код
WinProcs.AbortProc(Printer.Handle);
но этого не происходит. Вызывайте это сами каждый раз при использовании Printer.Abort.
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 03245
Category:Принтер
При использовании BDE, попытка вызвать abort выдает ошибку компиляции

=== При использовании BDE, попытка вызвать abort выдает ошибку компиляции ===
При использовании модулей доступа к BDE (DbiTypes, DbiProcs, DbiErrs), любая попытка вызвать процедуру abort выдает ошибку при компиляции при вызове метода abort "Statement expected, but expression of type 'Integer' found". Я пытался найти DbiTypes.pas, DbiProcs.pas и DbiErrs.pas чтобы разобраться но не нашел этих файлов. Где расположены эти файлы и как обойти ошибку?
Модули DbiTypes, DbiProcs, DbiErrs это псевдонимы модуля "BDE", объявлены в
 Projects -> Options -> Directories/Conditionals -> Unit Aliases
Исходник модуля DBE находится в каталоге "doc" и называется "BDE.INT". В этом файле объявлена константа ABORT со значением -2. Так как Вы хотите использовать процедуру Abort(), которая объявлена в модуле SysUtils, Вам нужно добавить префикс SysUtils перед вызовом процедуры Abort.
 SysUtils.Abort;
ID: 02578
При использовании DOS DBF файлов - перекодировка между форматами

=== При использовании DOS DBF файлов - перекодировка между форматами ===
При использовании DOS DBF файлов можно сделать небольшую программку (или процедурку), которая произведет перекодировку между форматами. что-то типа:
function update_dos(s: string): string;
var
 c: string;
 I: Integer;
 l: Byte;
 dd: Char;
begin
 i := 1;
 c := ;
 while i < Length(s)+1 do
 begin
 l := Ord(s[i]);
 Inc(i);
 if (l >= 128) and (l <= 192) then
 l := l + 64
 else if (l >= 224) and (l < 240) then
 l := l + 16
 else if l = 241 then
 l := 184
 else if l = 240 then
 l := 168;
 dd := Chr(l);
 c := c + dd;
 end;
 Result := c;
end;
function update_win(s: string): string;
var
 c: string;
 I: Integer;
 l: Byte;
 dd: Char;
begin
 i := 1;
 c := ;
 while i < Length(s)+1 do
 begin
 l := Ord(s[i]);
 Inc(i);
 if (l >= 192) and (l < 240) then
 l := l - 64
 else if (l >= 240) and (l < 256) then
 l := l - 16
 else if l = 184 then
 l := 241
 else if l = 168 then
 l := 240;
 dd := chr(l);
 c := c + dd;
 end;
 Result := c;
end;
это и туда и обратно, у меня работает на старых DBF. Осталось только вызвать в нужный момент.
Source: Взято с http://delphiworld.narod.ru
ID: 02704
При попытке регистрации UDF возникает ошибка - udf not defined

=== При попытке регистрации UDF возникает ошибка - udf not defined ===
Располагайте DLL в каталоге Interbase/Bin, или в одном из каталогов, в которых ОС обязательно будет произведен поиск этой библиотеки (для Windows это %SystemRoot% и %Path%);
При декларировании функции не следует указывать расширение модуля (в Windows по умолчанию DLL):
declare external function f_SubStr
cstring(254), integer, integer
returns
cstring(254)
entry_point "Substr" module_name "UDF1"
Где UDF1 - UDF1.DLL.
Author: Nomadic
Source: Взято с http://delphiworld.narod.ru
ID: 02925
Category:Базы данных
Category:Interbase
При чтении почты POP3 отделять Attachment и сохранять в файл

Почту читаю, используя компонент tnmpop3 (стандартный в поставке d5), еще пробовал использовать библитеку indy, но не помогло. А проблема заключается в том, что после прочтения письма, невозможно отделить аттачмент от тела. Но это происходит не со всеми письмами. Если я отправлю письмо с аттачем, то я могу его нормально читать и разбирать, а если отправляет Заказчик, то получается то, что я описал. Причем, outlook и thebat, эти письма нормально читают и аттач МОЖНО сохранить.
for IntIndex := 0 to Pred(Msg.MessageParts.Count) do
begin
 if (Msg.MessageParts.Items[IntIndex] is TIdAttachment) then
 begin // general attachment
 TIdAttachment(Msg.MessageParts.Items[IntIndex]).SaveToFile(
 TIdAttachment(Msg.MessageParts.Items[IntIndex]).FileName);
 TIdAttachment.Create(Msg1.MessageParts,
 TIdAttachment(Msg.MessageParts.Items[IntIndex]).FileName);
 end
 else
 begin // body text
 if Msg.MessageParts.Items[IntIndex] is TIdText then
 begin
 Memo1.Lines.Clear;
 Memo1.Lines.AddStrings(TIdText(Msg.MessageParts.Items[IntIndex]).Body);
 end;
 end;
end;
Source: http://articles.org.ru/
ID: 03411
Category:Связь
Category:Электронная почта
Прибавить час

=== Прибавить час ===
Тип TDateTime, используемый для передачи даты и времени, это тип double, у которого целая часть определяет день, а дробная время от полуночи. То есть, если прибавить ко времени 1, то дата изменится на один день, а время не изменится. Если прибавить 0.5, то прибавится 12 часов. Причем этот метод работает даже в том случае, когда меняется дата, месяц или год. 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Label1.Caption := DateTimeToStr(Time);
 Label2.Caption := DateTimeToStr(Time + 1 / 24);
end;
Source: http://delphiworld.narod.ru
ID: 00770
Привлечение внимания к окну

=== Привлечение внимания к окну ===
Часто возникает проблема - в многооконном приложении необходимо обратить внимание пользователя на то, что какое-то из окон требует внимания (например, к нему пришло сообщение по DDE, в нем завершился какой-либо процесс, произошла ошибка...). Это легко сделать, используя команду API FlashWindow:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 FlashWindow(Handle,true);
end;
Source: http://dmitry9.nm.ru/info/
ID: 00423
Придание MDI-формам большей трехмерности

=== Придание MDI-формам большей трехмерности ===
constructor TMainForm.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 SetWindowLong(ClientHandle, GWL_EXSTYLE,
 GetWindowLong(ClientHandle, GWL_EXSTYLE) or WS_EX_CLIENTEDGE);
 SetWindowPos(ClientHandle, 0, 0, 0, 0, 0,
 swp_DrawFrame or swp_NoMove or swp_NoSize or swp_NoZOrder);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00498
Приложение, использующее компоненты многомерного представления данных

=== Приложение, использующее компоненты многомерного представления данных ===
Приложение, использующее компоненты многомерного представления данных
* Приложение, использующее компоненты многомерного представления данных
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02426
Приложение с различным разрешением монитора?

Из рассылки "Мастера DELPHI. Новости мира компонент, FAQ, статьи..."
Приложение, адекватно отображающееся на экранах с различным разрешением монитора?
unit Main;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics,
 Controls, Forms, Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Edit1: TEdit;
 procedure Button1Click(Sender: TObject);
 procedure FormCreate(Sender: TObject);
 private
 { Отлавливаем, сообщение о изменении разрешения экрана }
 procedure WMDisplayChange(var message: TMessage); message WM_DISPLAYCHANGE;
 public
 W, H: Integer;
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
 Width := Round(Width * 1.5);
 Height := Round(Height * 1.5);
 ScaleBy(150, 100)
end;
procedure TForm1.WMDisplayChange(var message: TMessage);
begin
 inherited;
 Width := Round(Width * LOWORD(message.LParam) / W);
 Height := Round(Height * HIWORD(message.LParam) / H);
 ScaleBy(LOWORD(message.LParam), W);
 W := Screen.Width;
 H := Screen.Height;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 W := Screen.Width;
 H := Screen.Height;
end;
end.
Source: Vingrad.ru http://forum.vingrad.ru
ID: 04527
Category:Разработка приложений
Category:Оптимизация и отладка
Пример, показывающий принцип работы с Memory Mapped Files.

=== Пример, показывающий принцип работы с Memory Mapped Files. ===
Пример, показывающий принцип работы с Memory Mapped Files.
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03136
Category:Файловая система
Пример DDE и WordPerfect

Вот небольшой пример, скопированный из моего проекта:
procedure TForm1.PrintSave(Doc: string);
var
 ProdDoc, ArchDoc: string;
 WPCommands: TStringList;
begin
 ProdDoc := ProdDrive + Doc;
 ArchDoc := ArchDrive + Doc;
 WPCommands := TStringList.Create;
 with WPCommands do
 begin
 Add('FileOpen(Filename:"' + ProdDoc + '")');
 Add('FileSave(Filename:"' + ProdDoc + '";ExportType:3;Overwrite:1)');
 Add('PrintCopies(NumberOfCopies:2)');
 Add('PrintCopiesBy(CopiesBy:1) ');
 Add('PrintFullDoc() ');
 Add('DocCompare(FileName:"' + ArchDoc + '";CompFlags:1) ');
 Add('FileSave(Filename:"' + EMailDoc + '";ExportType:3;Overwrite:1');
 Add('Close(Save:0) ');
 end;
 if PDDE.ExecuteMacroLines(WPCommands, True) then
 begin
 log('WPCommand Worked!')
 { Теперь необходимо подождать WP, чтобы завершить команду... }
 end
 else
 log('Ошибка WPCommand!');
 WPCommands.Free;
end;
;Примечание: Вы не можете использовать 'True!' или 'False!', как это делается в макросах WP. Вы должны использовать числовые значения. Как узнать числовой эквивалент команды: если в WP использовать построитель макросов, то можно передавать перечислимые типы в диалоговое окно и узнавать их числовой эквивалент.
Все это проверено, DDE работает в связке WP/Delphi, первая команда возвращает сообщение 'Ok, я получил это', и запускает макрос. При попытке послать второй запрос DDE, он ожидает завершение обработки первого, выводит сообщение типа 'Необходимо подождать....', после чего немедленно передает управление. Мне хотелось бы дождаться команды завершения прежде, чем я возвращусь из своей процедуры.
Author: John Studt 
Source: http://delphiworld.narod.ru/
ID: 04504
Category:DDE
Пример DbiAddFilter

=== Пример DbiAddFilter ===
type
 TmyFilter = record
 Expr: CANExpr;
 Nodes: array[0..2] of CANNode;
 literals: array[0..7] of char;
 end;
const
 myFilter: TMyFilter = (Expr:
 (iVer: 1; iTotalSize: sizeof(TMyFilter); iNodes: 3;
 iNodeStart: sizeof(CANExpr); iLiteralStart: sizeof(CANExpr) +
 3 * sizeof(CANNode));
 Nodes:
 ((canBinary: (nodeClass: nodeBinary; canOP: canEQ;
 iOperand1: sizeof(CANNode); iOperand2: 2 * sizeof(CANNode))),
 (canField: (nodeClass: nodeField; canOP: canField2;
 iFieldNum: 0; iNameOffset: 0)),
 (canConst: (nodeClass: nodeConst; canOP: canCONST2;
 iType: fldZSTRING; iSize: 3; iOffset: 5)));
 literals:
 ('T', 'Y', 'P', 'E', #0, 'I', 'N', #0));
var
 dbResult: DBIResult;
 hFilter, hFilter1: hDBIFilter;
begin (* procedure SetupFilter *)
 dbResult := DbiAddFilter(tblAP_.Handle, 1, 1, False, addr(myFilter), nil, hFilter);
 dbResult := DbiActivateFilter(tblAP_.Handle, hFilter);
 tblAP_.First;
 myFilter.nodes[0].canBinary.canOp := canNE;
 dbResult := DbiAddFilter(tblAP1_.Handle, 1, 1, False, addr(myFilter), nil, hFilter1);
 dbResult := DbiActivateFilter(tblAP1_.Handle, hFilter1);
 tblAP1_.First;
 myFilter.nodes[0].canBinary.canOp := canEQ;
end;
Этот пример устанавливает два фильтра. Первый (применяемый к tblAP_) выводит все записи, где ТИП поля имеет значение 'IN'. Второй (применяемый к tblAP1_) выводит все записи, где ТИП поля не имеет значения 'IN'.
Также необходимо включить в ваш файл файлы DBITYPES и DBIPROCS, где определены вызываемые функции и константы.
Author: Mark Erbaugh
Source: Взято с http://delphiworld.narod.ru
ID: 02534
Пример TDrawGrid Drawcell

=== Пример TDrawGrid Drawcell ===
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Longint;
 Rect: TRect; State: TGridDrawState);
var
 vRow, vCol: LongInt;
begin
 vRow := Row;
 vCol := Col;
 with Sender as TDrawGrid, Canvas do
 begin
 if (vRow = 0) or (vCol = 0) then
 Font.Color := clBlack
 else
 Font.Color := clRed;
 TextRect(Rect, Rect.Left, Rect.Top, Format('(%d,%d)', [vRow, vCol]));
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01102
----
Это код, который я использую для печати TMemoField в TDBGrid. Перекрываем (override) метод DrawCell:
Canvas.FillRect(ARect);
R := ARect;
with TMemoField(Field) do
 DrawText(Canvas.Handle, PChar(Value), Length(Value), R, DT_WORDBREAK OR DT_NOPREFIX);
Я думаю этот код, который я создал в Delphi 1.0, должен помочь вам:
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
 Rect: TRect; State: TGridDrawState);
var
 bufB: array[0..79] of Char;
 algn: Word;
begin
 algn := 0;
 if (Col = NumbColK) or (Col = PrceColK) or
 (Col = TtlColK) then
 algn := dt_Right;
 if Row = 0 then
 algn := dt_Center;
 if algn = 0 then
 Exit;
 StringGrid1.Canvas.FillRect(Rect);
 StrPCopy(bufB, StringGrid1.CellS[Col, Row]);
 Rect.Top := Rect.Top + 2;
 Rect.Right := Rect.Right - 2;
 DrawText(StringGrid1.Canvas.Handle, bufB, -1, Rect, algn);
end;
В первой части необходимо установить нужное вам выравнивание, и очистить старый текст. 
Число -1, поскольку, я думаю, bufB должен быть строкой с терминирующим нулем, в которую вы можете помещать любое число, например, 10, и он должен ограничивать вашу строку до 10, как раз то, что вы хотели.
...действительно, в зависимости от вашего приложения, можно все значительно упростить. Если вы заполняете сетку из другого источника, просто сделайте так:
Grid.Cells[Col, Row] := TrimWithDots(myString, Form1.Canvas, Grid.Widths[Col]-2);
где trimWithDots-функция, с помощью которой вычисляется количество пикселей, необходимых для написания в ячейки сетки строки myString. При этом у myString обрезаются левые и правые пробелы, а для определения ширины используется функция холста textWidth:
function TrimWithDots(const myString: string; Canvas: TCanvas; wid: integer): string;
begin
 Result := myString;
 while Canvas.TextWidth(Result) > wid do
 Delete(Result, Length(Result), 1);
end;
Естественно, вы можете сделать это более грамотнее, добавляя к правильно-обрезанному тексту '...'. По какой-то странной причине, grid.canvas почему-то возвращает мне неверные результаты, поэтому я всегда работаю с form1.canvas, который меня никогда не подводил. 
Если вы не загружаете сетку из другого источника, вы можете все делать так, как описано выше, но помещая код в обработчик события onDrawDataCell. В этом случае сетка нарисует за вас все линии, вам же останется нарисовать только содержимое.
Source: http://delphiworld.narod.ru/
ID: 01105
Пример вызова TUTILITY DLL из Delphi?

=== Пример вызова TUTILITY DLL из Delphi? ===
var
 Session: hTUses;
 i: integer;
 ErrorCode: word;
 ResultCode: word;
procedure BdeError(ResultCode: Word);
begin
 if ResultCode <> 0 then
 raise Exception.CreateFmt('BDE ошибка %x', [ResultCode]);
end;
begin
 try
 BdeError(DbiInit(nil));
 BdeError(TUInit(@Session));
 for i := 1 to High(TableNames) do
 begin
 WriteLn('Проверка ' + TableNames[i]);
 ResultCode := TUVerifyTable(Session, @TableNames[i, 1], szPARADOX, 'TABLERRS.DB', nil, TU_Append_Errors, ErrorCode);
 BdeError(ResultCode);
 if ErrorCode = 0 then
 WriteLn('Успешно')
 else
 WriteLn('ОШИБКА! -- Для информации смотри TABLERRS.DB!');
 WriteLn();
 end;
 finally
 BdeError(TUExit(Session));
 BdeError(DbiExit);
 end;
end.
Сборник Kuliba
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02637
Пример записи информации в битмап

type
 BITMAPFILEHEADER = packed record
 bfType: WORD; // Сигнатура BM
 bfSize: DWORD; // Размер файла
 bfReserved1: WORD; // Зарезервировано, всегда 0
 bfReserved2: WORD; // Тот же случай
 bfOffBits: DWORD; // Смещение(в байтах) от заголовка(его размер)
 end;
 BITMAPINFOHEADER = packed record
 biSize: DWORD; // Число байтов, необходимых этой структуре
 biWidth: LONGWORD; // Ширина
 biHeight: LONGWORD; // Высота
 biPlanes: WORD; // Число плоскостей устройства. =1
 biBitCount: WORD; // Число битов на пиксел. В примере =24
 biCompression: DWORD; // Тип сжатия. В примере =0(т.е. нет)
 biSizeImage: DWORD; // Размер изобр. 0, если нет сжатия
 biXPelsPerMeter: LONGWORD; // Горизонтальное разрешение (пиксел/м)
 biYPelsPerMeter: LONGWORD; // Вертикальное разрешение (пиксел/м)
 biClrUsed: DWORD; // Используемые цвета. 0 - исп. все
 biClrImportant: DWORD; // Важные цвета. 0 - все важны
 end;
// Если хотите знать больше, смотрите SDK->Поиск->BMP->Bitmap Storage
implementation
{$R *.dfm}
procedure FileToBMP(FileName: string; w, h: Integer);
var
 fsBmp, fsFile: TStream;
begin
 fsBmp := TFileStream.Create(FileName + '.bmp', fmCreate);
 fsFile:= TFileStream.Create(FileName, fmOpenRead);
 bf.bfType := $4D42; // = BM
 bf.bfReserved1 := 0;
 bf.bfReserved2 := 0;
 bf.bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
 bi.biSize := SizeOf(BITMAPINFOHEADER);
 bi.biWidth := w;
 bi.biHeight := h;
 bi.biPlanes := 1;
 bi.biBitCount := 24;
 bi.biCompression := 0;
 bi.biSizeImage := w * h * 3; // 24 бита = 3 байта
 // остальное в этом примере = 0
 bi.biXPelsPerMeter := 0;
 bi.biYPelsPerMeter := 0;
 bi.biClrUsed := 0;
 bi.biClrImportant := 0;
 bf.bfSize := bf.bfOffBits + bi.biSizeImage;
 // запись заголовка
 fsBmp.Write(bf, SizeOf(BITMAPFILEHEADER));
 fsBmp.Write(bi, SizeOf(BITMAPINFOHEADER));
 // запись точек (кол-во байтов = bi.biSizeImage)
 fsBmp.CopyFrom(fsFile, bi.biSizeImage);
 fsBmp.Free;
 fsFile.Free;
end;
Author: Аэтерос 
Source: http://forum.sources.ru
ID: 03776
Category:Графика
Category:Bitmap
Пример запуска макроса в MS WinWord

vvWord:= CreateOleObject('Word.Application.8');
vvWord.Application.Visible := True;
vvWord.Documents.Open(TempFileName);
vvWord.ActiveDocument.SaveAs(FileName, 1); // as .DOC
vvWord.Application.Run('Macros Name');
ID: 04433
Category:COM
Category:MS Office
Пример использования закладок (класс TBookmark)

=== Пример использования закладок (класс TBookmark) ===
Пример использования закладок (класс TBookmark)
* Пример использования закладок (класс TBookmark) в наборах данных Delphi
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02423
Пример использования компоненты синхронного просмотра

=== Пример использования компоненты синхронного просмотра ===
Пример использования компоненты синхронного просмотра
* Приложение баз данных, использующее компоненты синхронного просмотра
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02424
Пример использования отношения "один-ко-многим"

=== Пример использования отношения "один-ко-многим" ===
Пример использования отношения "один-ко-многим"
Приложение баз данных, использующее отношение "один-ко-многим" между таблицами базы данных
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02421
Пример использования параметров компонентов запросов SQL

=== Пример использования параметров компонентов запросов SQL ===
Пример использования параметров компонентов запросов SQL
Пример использования параметров компонентов запросов SQL и взаимодействия таких компонентов на основе передачи значений параметров
Author: Akella 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02420