nyuuzyou/wikis huggingface dataset:
Дополнение строки пробелами

=== Дополнение строки пробелами ===
{ **** UBPFD *********** by delphibase.endimus.com ****
Дополняет строку пробелами до указанной длины
Зависимости: нет
Автор: Anatoly Podgoretsky, anatoly@podgoretsky.com, Johvi
Copyright:
Дата: 26 апреля 2002 г.
***************************************************** }
// Дополняет строку слева пробелами до указанной длины
function PADL(Src: string; Lg: Integer): string;
begin
 Result := Src;
 while Length(Result) < Lg do
 Result := ' ' + Result;
end;
// Дополняет строку пробелами справа до указанной длины.
function PADR(Src: string; Lg: Integer): string;
begin
 Result := Src;
 while Length(Result) < Lg do
 Result := Result + ' ';
end;
// Дополнение строки пробелами с обоих сторон до указанной длины
function PADC(Src: string; Lg: Integer): string;
begin
 Result := Src;
 while Length(Result) < Lg do
 begin
 Result := Result + ' ';
 if Length(Result) < Lg then
 begin
 Result := ' ' + Result;
 end;
 end;
end;
// Пример использования: 
S := PADL(S,32); 
Source: http://delphibase.endimus.com
ID: 00842
Дополненный TRegistry, умеет работать с значениями типа REG MULTI SZ

=== Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ ===
unit Reg;
{$R-,T-,H+,X+}
interface
uses Registry, Classes, Windows, Consts, SysUtils;
type
 TReg = class(TRegistry)
 public
 procedure ReadStringList(const name: string; list: TStringList);
 procedure WriteStringList(const name: string; list: TStringList);
 end;
implementation
//*** TReg *********************************************************************
//------------------------------------------------------------------------------
// Запись TStringList в виде значения типа REG_MULTI_SZ в реестр
//------------------------------------------------------------------------------
procedure TReg.WriteStringList(const name: string; list: TStringList);
var
 Buffer: Pointer;
 BufSize: DWORD;
 i, j, k: Integer;
 s: string;
 p: PChar;
begin
 { подготовим буфер к записи }
 BufSize := 0;
 for i := 0 to list.Count - 1 do
 Inc(BufSize, Length(list[i]) + 1);
 Inc(BufSize);
 GetMem(Buffer, BufSize);
 k := 0;
 p := Buffer;
 for i := 0 to list.Count - 1 do
 begin
 s := list[i];
 for j := 0 to Length(s) - 1 do
 begin
 p[k] := s[j + 1];
 Inc(k);
 end;
 p[k] := Chr(0);
 Inc(k);
 end;
 p[k] := Chr(0);
 { запись в реестр }
 if RegSetValueEx(CurrentKey, PChar(name), 0, REG_MULTI_SZ, Buffer,
 BufSize) <> ERROR_SUCCESS then
 raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [name]);
end;
//------------------------------------------------------------------------------
// Чтение TStringList в виде значения типа REG_MULTI_SZ из реестра
//------------------------------------------------------------------------------
procedure TReg.ReadStringList(const name: string; list: TStringList);
var
 BufSize, DataType: DWORD;
 Len, i: Integer;
 Buffer: PChar;
 s: string;
begin
 if list = nil then
 Exit;
 { чтение из реестра }
 Len := GetDataSize(Name);
 if Len < 1 then
 Exit;
 Buffer := AllocMem(Len);
 if Buffer = nil then
 Exit;
 try
 DataType := REG_NONE;
 BufSize := Len;
 if RegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer),
 @BufSize) <> ERROR_SUCCESS then
 raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [name]);
 if DataType <> REG_MULTI_SZ then
 raise ERegistryException.CreateResFmt(@SInvalidRegType, [name]);
 { запись в TStringList }
 list.Clear;
 s := ;
 for i := 0 to BufSize - 2 do
 begin // BufSize-2 т.к. последние два нулевых символа
 if Buffer[i] = Chr(0) then
 begin
 list.Add(s);
 s := ;
 end
 else
 s := s + Buffer[i];
 end;
 finally
 FreeMem(Buffer);
 end;
end;
end.
Author: Кондратюк Виталий
Source: http://delphiworld.narod.ru/
ID: 02282
Дополнительные константы цветов

unit UnitColorConstants;
{-----------------------------------------------------------------
 Unit Name: UnitColorConstants
 Version: 2.0
 Author: Stewart Moss
 Creation Date: Jan 31 2002 11:54 pm
 Modification Date: Feb 21 2002
 Dependancies:
 Description:
-- This code is copyright (Jan 31 2002) by Stewart Moss
-- All rights Reserved.
-----------------------------------------------------------------}
interface
uses Graphics;
const
 clNicePaleGreen = TColor($CCFFCC);
 clPaleRed = TColor($CCCCFF);
 clNicePurple = TColor($00E1E100);
 clKhaki = TColor($ADAE80);
 clMonkeyGreen = TColor($00C0DCC0);
 clSkyBlue = TColor($00F1CAA6);
 clMedGray = TColor($00A4A0A0);
 clCream = TColor($00EFFBFF);
 clChocolate = TColor($17335C);
 clDarkBrown = TColor($5C3340);
 clDarkSlateGrey = TColor($4F4F2F);
 clDarkTan = TColor($4F6997);
 clDarkWood = TColor($425E85);
 clLightWood = TColor($A6C2E9);
 clMediumWood = TColor($6480A6);
 clNewTan = TColor($9EC7EB);
 clSemiSweetChocolate = TColor($26426B);
 clSienna = TColor($236B8E);
 clWheat = TColor($BFD8D8);
 clBrass = TColor($42A6B5);
 clBronze = TColor($53788C);
 clBronzeII = TColor($3D7DA6);
 clCoolCopper = TColor($1987D9);
 clCopper = TColor($3373B8);
 clQuartz = TColor($F3D9D9);
 clFieldSpar = TColor($7592D1);
 clGoldenrod = TColor($70DBDB);
 clMediumGoldenrod = TColor($AEEAEA);
 clBrightGold = TColor($19D9D9);
 clGold = TColor($327FCD);
 clOldGold = TColor($3BB5CF);
 clCoral = TColor($007FFF);
 clFirebrick = TColor($23238E);
 clIndianRed = TColor($2F2F4E);
 clMandarianOrange = TColor($3378E4);
 clMediumVioletRed = TColor($9370DB);
 clNeonPink = TColor($C76EFF);
 clOrangeRed = TColor($0024FF);
 clScarlet = TColor($17178C);
 clSpicyPink = TColor($AE1CFF);
 clThistle = TColor($D8BFD8);
 clVioletRed = TColor($9932CC);
 clDarkOliveGreen = TColor($2F4F4F);
 clForestGreen = TColor($238E23);
 clHunterGreen = TColor($215E21);
 clMediumForestGreen = TColor($238E6B);
 clMediumSeaGreen = TColor($426F42);
 clMediumSpringGreen = TColor($00FF7F);
 clPaleGreen = TColor($8FBC8F);
 clSeaGreen = TColor($688E23);
 clSpringGreen = TColor($7FFF00);
 clYellowGreen = TColor($32CC99);
 clAquamarine = TColor($93DB70);
 clCadetBlue = TColor($9F9F5F);
 clCornFlowerBlue = TColor($6F4242);
 clDarkTurquoise = TColor($DB9370);
 clLightBlue = TColor($D9D9C0);
 clLightSteelBlue = TColor($BD8F8F);
 clMediumAquamarine = TColor($99CD32);
 clMediumBlue = TColor($CD3232);
 clMediumTurquoise = TColor($DBDB70);
 clMidnightBlue = TColor($4F2F2F);
 clNeonBlue = TColor($FF4D4D);
 clNewMidnightBlue = TColor($9C0000);
 clRichBlue = TColor($AB5959);
 clSlateBlue = TColor($FF7F00);
 clSteelBlue = TColor($8E6B23);
 clSummerSky = TColor($DEB038);
 clTurquoise = TColor($EAEAAD);
 clBlueViolet = TColor($9F5F9F);
 clOrchid = TColor($DB70DB);
 clDarkPurple = TColor($781F87);
 clViolet = TColor($4F2F4F);
 clDarkOrchid = TColor($CD3299);
 clMediumSlateBlue = TColor($007FFF);
 clDarkSlateBlue = TColor($8E236B);
 clMediumOrchid = TColor($DB7093);
implementation
end.
Source: http://www.baltsoft.com/
ID: 03693
Category:Графика
Category:Цвета и палитры
Допустимые периоды истечения времени

=== допустимые периоды истечения времени ===
{ 
 Retrieves information about the time-out period associated 
 with the accessibility features. 
 The pvParam parameter must point to an ACCESSTIMEOUT 
 structure that receives the information. 
 Set the cbSize member of this structure and the 
 uiParam parameter to SizeOf(ACCESSTIMEOUT). 
}
// ACCESSTIMEOUT structure 
type
 TAccessTimeOut = record
 cbSize: UINT;
 dwFlags: DWORD;
 iTimeOutMSec: DWORD;
 end;
procedure GetAccessTimeOut(var bTimeOut: Boolean; var bFeedBack: Boolean;
 var iTimeOutTime: Integer);
 // bTimeOut: the time-out period for accessibility features. 
 // bFeedBack: the operating system plays a descending 
 // siren sound when the time-out period elapses and the 
 // Accessibility features are turned off. 
 // iTimeOutTime: Timeout in ms 
var
 AccessTimeOut: TAccessTimeOut;
begin
 ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));
 AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);
 SystemParametersInfo(SPI_GETACCESSTIMEOUT, SizeOf(AccessTimeOut), @AccessTimeOut, 0);
 bTimeOut := (AccessTimeOut.dwFlags and ATF_TIMEOUTON) = ATF_TIMEOUTON;
 bFeedBack := (AccessTimeOut.dwFlags and ATF_ONOFFFEEDBACK) = ATF_ONOFFFEEDBACK;
 iTimeOutTime := AccessTimeOut.iTimeOutMSec;
end;
// Test it: 
procedure TForm1.Button2Click(Sender: TObject);
var
 bTimeOut, bFeedBack: Boolean;
 iTimeOutTime: Integer;
begin
 GetAccessTimeOut(bTimeOut, bFeedBack, iTimeOutTime);
 label1.Caption := IntToStr(Ord(bTimeOut));
 Label2.Caption := IntToStr(Ord(bFeedBack));
 Label3.Caption := IntToStr(iTimeOutTime);
end;
 { 
 Sets the time-out period associated with the accessibility features. 
 The pvParam parameter must point to anACCESSTIMEOUT structure that 
 contains the new parameters. 
 Set the cbSize member of this structure and the uiParam 
 parameter to sizeof(ACCESSTIMEOUT). 
}
 { 
 Setzt Informationen zu den ACCESSEDTIMEOUT-Eigenschaften. 
 "uiParam" erwartet die Gro?e der ACCESSEDTIMEOUT-Struktur, 
 die in "pvParam" ubergeben werden muss. 
}
procedure SetAccessTimeOut(bTimeOut, bFeedBack: Boolean; iTimeOutTime: Integer);
// bTimeOut: If true, a time-out period has been set for accessibility features. 
// bFeedBack: If true, the operating system plays a descending 
// siren sound when the time-out period elapses and the 
// accessibility features are turned off. 
// iTimeOutTime: Timeout in ms 
var
 AccessTimeOut: TAccessTimeOut;
begin
 ZeroMemory(@AccessTimeOut, SizeOf(TAccessTimeOut));
 AccessTimeOut.cbSize := SizeOf(TAccessTimeOut);
 case bTimeOut of
 True: AccessTimeOut.dwFlags := ATF_TIMEOUTON;
 False: AccessTimeOut.dwFlags := 0;
 end;
 if bFeedBack then
 AccessTimeOut.dwFlags := AccessTimeOut.dwFlags or ATF_ONOFFFEEDBACK;
 AccessTimeOut.iTimeOutMSec := iTimeOutTime;
 SystemParametersInfo(SPI_SETACCESSTIMEOUT, SizeOf(AccessTimeOut),
 @AccessTimeOut, SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;
// Test it: 
procedure TForm1.Button1Click(Sender: TObject);
begin
 SetAccessTimeOut(True, True, 600000); // 10 min. timeout 
end;
Source: http://delphiworld.narod.ru
ID: 00773
Доступ к Oracle через ADO

=== Доступ к Oracle через ADO ===
Для доступа к данных хранящимся в Oracle лучше всего использовать не компоненты ADO а компоненты библиотека DAO (Data Access Oracle) с ними так же просто разобраться как и со стандартными компонентами, к тому же они работают на прямую с Oracle, без каких-либо посредников (например BDE, или тот же ODBC), и заточены соответственно под него. Линк точный дать не могу, но найти их будет не трудно (воспользуйся поисковой системой)...
Но если все же решил использовать ADO вот тебе строка:
1) способ если использовать "MS OLE DB Provaider for Oracle" - это провайдер мелкомягких
 Provider=MSDAORA.1;Password=USER123;User ID=USER;Data Source=MyDataSourse;
 Persist Security Info=False
2) способ если использовать "Oracle Provaider for Ole DB" - это провайдер от Oracle
 Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=USER;Data Source=MyDataSourse
Author: Pegas
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02720
Доступ к объекту Oracle

=== Доступ к объекту Oracle ===
Для этого можно воспользоваться компонентами от AllRoundAutomations Direct Oracle Access. Если кому надо могу поделиться. При помощи этих компонент можно не только производить простые запросы/вставки, но и выполнять DDL-скрипты, и иметь доступ к объектам Oracle 8, примет смотри ниже...
var
 Address: TOracleObject;
begin
 Query.SQL.Text := 'SELECT Name, Address FROM Persons';
 Query.Execute;
 while not Query.Eof do
 begin
 Address := Query.ObjField('Address');
 if not Address.IsNull then
 ShowMessage(Query.Field('Name') + ' lives in ' + Address.GetAttr('City'));
 Query.Next;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02721
Доступ к страницам Tabbednotebook

=== Доступ к страницам Tabbednotebook ===
При добавлении компонентов во время выполнения программы, вам необходимо присвоить для каждого компонента свойству parent (контейнер) _страницу_ компонента notebook, а не сам notebook. 
Вы можете сделать это следующим образом (пример дан для кнопки):
MyButton := TButton.Create(Form1); { как обычно... }
MyButton.Parent := TTabPage(TabbedNotebook1.Pages.Objects[n]);
{ <== где 'n' - индекс желаемой страницы ==> }
Свойство notebook 'Pages' имеет тип StringList и содержит список заголовков и объектов 'TTabPage'. 
Я сам пользовался этой техникой несколько месяцев. Не могу вспомнить где я сам раздобыл эту информацию, но в документации про это ничего не сказано. Может кто-нибудь знает, где об этом написано? 
При добавлении компонента на страницу TabbedNotebook во время выполнения приложения, указатель на желаемую страницу для свойства Parent нового компонента должен быть назначен перед тем, как он будет реально показан. Способ получить доступ ко всем страницам TTabbedNotebook во время выполнения программы - с помощью свойства-массива Objects свойства TabbedNotebook Pages. Другими словами, страничные компоненты хранятся как объекты, присоединенные к имени страницы в списке строк свойства Pages. В следующим коде показано создание кнопки на второй странице компонента TabbedNotebook1:
var
 NewButton : TButton;
begin
 NewButton := TButton.Create(Self);
 NewButton.Parent := TWinControl(TabbedNotebook1.Pages.Objects[1])
Вот как страница TNotebook может быть использована в качестве родителя для вновь создаваемого на ней компонента:
NewButton.Parent := TWinControl(Notebook1.Pages.Objects[1])
Вот как страница (закладка) TTabSet может быть использована в качестве родителя для вновь создаваемого на ней компонента:
NewButton.Parent := TWinControl(TabSet1.Tabs.Objects[1])
Source: Взято с http://delphiworld.narod.ru
ID: 01163
Если нажато более 2х клавиш одновременно...

=== Если нажато более 2х клавиш одновременно... ===
{
 I would like to detect more than 2 keys being pressed within a form.
 For example I would like to know if the user pressed time. The onkeydown seems to only check for one or two keys max but surely
 you can determine what keys are currently down.
}
// You can use GetKeyState:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if ((GetKeyState(VK_CONTROL) AND 128) = 128)
 and ((GetKeyState(VK_F5) AND 128) = 128)
 and ((GetKeyState(ord('8')) AND 128) = 128)
 then
 ShowMessage('CTRL+F5+8 Pressed');
end;
( Remember: Form1.Keypreview := TRUE )
// Or you can read the entire KeyBoard Status,
// and later check for the three keys:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
 KeybState: TKeyboardState;
begin
 GetKeyboardState(KeybState);
 if ((KeybState[VK_CONTROL] and 128) = 128)
 and ((KeybState[VK_F5] and 128) = 128)
 and ((KeybState[Ord('8')] and 128) = 128)
 then
 ShowMessage('CTRL+F5+8 Pressed');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01525
Если отображается только часть TImage

=== Если отображается только часть TImage ===
При увеличении размера компонента TImage в RunTime пытаюсь рисовать заново на всем поле, но отображается только часть компонента (прежнего размера). В чем дело?
Нужно при инициализации выполнить SetBounds(), с максимальными размерами.
Source: http://dmitry9.nm.ru/info/
ID: 01255
Если прозрачная часть glyph'а становится видной...

=== Если прозрачная часть glyph'а становится видной... ===
В некоторых видео режимах прозрачная часть glyph'а стандартного TBitBtn становится видной. Как этого избежать? 
В примере используется техника закраски прозрачной части glyph'а цветом кнопки на которой он находится - таким образом glyph кажется прозрачным. 
function InitStdBitBtn(BitBtn: TBitBtn; kind: TBitBtnKind): bool;
var
 Bm1: TBitmap;
 Bm2: TBitmap;
begin
 Result := false;
 if Kind = bkCustom then
 exit;
 Bm1 := TBitmap.Create;
 case Kind of
 bkOK: Bm1.Handle := LoadBitmap(hInstance, 'BBOK');
 bkCancel: Bm1.Handle := LoadBitmap(hInstance, 'BBCANCEL');
 bkHelp: Bm1.Handle := LoadBitmap(hInstance, 'BBHELP');
 bkYes: Bm1.Handle := LoadBitmap(hInstance, 'BBYES');
 bkNo: Bm1.Handle := LoadBitmap(hInstance, 'BBNO');
 bkClose: Bm1.Handle := LoadBitmap(hInstance, 'BBCLOSE');
 bkAbort: Bm1.Handle := LoadBitmap(hInstance, 'BBABORT');
 bkRetry: Bm1.Handle := LoadBitmap(hInstance, 'BBRETRY');
 bkIgnore: Bm1.Handle := LoadBitmap(hInstance, 'BBIGNORE');
 bkAll: Bm1.Handle := LoadBitmap(hInstance, 'BBALL');
 end;
 Bm2 := TBitmap.Create;
 Bm2.Width := Bm1.Width;
 Bm2.Height := Bm1.Height;
 Bm2.Canvas.Brush.Color := ClBtnFace;
 Bm2.Canvas.BrushCopy(Rect(0, 0, bm2.Width, bm2.Height), Bm1,
 Rect(0, 0, Bm1.width, Bm1.Height),
 Bm1.canvas.pixels[0, 0]);
 Bm1.Free;
 LockWindowUpdate(BitBtn.Parent.Handle);
 BitBtn.Kind := kind;
 BitBtn.Glyph.Assign(bm2);
 LockWindowUpdate(0);
 Bm2.Free;
 Result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 InitStdBitBtn(BitBtn1, bkOk);
end;
ID: 01239
Естественное (Неймановское) слияние.

Естественное (Неймановское) слияние.
Она объединяются упорядоченные части, спонтанно возникшие в исходном массиве; они могут быть также следствием предыдущей обработки данных. Рассчитывать на одинаковый размер сливаемых частей не приходится.
Записи, идущие в порядке неубывания ключей, сцепляются, образуя подсписок. Минимальный подсписок одна запись.
Пример:
Пусть даны ключи записей
 5 7 8 3 9 4 1 7 6
Ищем подсписки
В один общий список соединяются 1-й, 3-й, 5-й и т. д. подсписки, в другой - 2-й, 4-й и т. д. подсписки.
Произведем слияние 1 подсписка 1 списка и 1 подсписка 2 списка, 2 подсписка 1 списка и 2 подсписка 2 списка и т.д.
Будут получены следующие цепи
 3 --> 5 --> 7 --> 8 --> 9 и 1 --> 4 --> 7
Подсписок, состоящий из записи "6", пары не имеет и "принудительно" объединяется с последней цепью, принимающей вид 1 --> 4--> 6 --> 7.
При нашем небольшом числе записей 2-й этап, на котором сливаются две цепи, окажется последним.
В общем случае на каждом этапе подсписок - результат слияния начальных подсписков 1 и 2 списка становится началом нового 1-го списка, а результат слияния следующих двух подсписков - началом 2-го списка. Следующие образуемые подсписки поочередно включаются в 1-й и во 2-й список.
Для программной реализации заводят массив sp: элемент sp[i] - это номер записи, которая следует за i-й.
Последняя запись одного подсписка ссылается на первую запись другого, а для различения концов подсписков эта ссылка снабжается знаком минус.
repeat { Повторение актов слияний подсписков }
 if A[j].kl < A[i].kl then { Выбирается меньшая запись }
 begin
 sp[k] := j;
 k := j;
 j := sp[j];
 if j <= 0 then { Сцепление с остатком "i"-подсписка }
 begin
 sp[k] := i;
 repeat
 m := i;
 i := sp[i]
 until i <= 0;
 end;
 end
 else
 begin
 sp[k] := i;
 k := i;
 i := sp[i];
 if i <= 0 then { Сцепление с остатком "j"-подсписка }
 begin
 sp[k] := j;
 repeat
 m := j;
 j := sp[j]
 until j <= 0;
 end;
 end;
 if j <= 0 then
 begin
 sp[m] := 0;
 sp[p] := -sp[p];
 i := -i;
 j := -j;
 if j <> 0 then
 p := r;
 k := r;
 r := m;
 end;
until j = 0;
В конец сформированного подсписка всегда заносится нулевая ссылка (sp[m] := 0), ибо он может оказаться последним.
Действие sp[p] := -sp[p] обозначает минусом конец ранее построенного подсписка.
В переменных i,j ссылки на начала новых сливаемых подсписков - со знаком минус; его снимаем. Переход к новым подспискам требует обновления переменных p, k, r
Author: www.structur.h1.ru
Source: http://delphiworld.narod.ru/
ID: 04171
Category:Алгоритмы
Category:Сортировка
Есть-ли способ восстановить несохраненные (uncommitted) изменения БД, например в случае отключения питания?

=== Есть-ли способ восстановить несохраненные (uncommitted) изменения БД, например в случае отключения питания? ===
Нет. Такие изменения будут потеряны. Т.е. БД останется в состоянии, соответствующем последней подтвержденной (committed) транзакции. Несохраненные данные в БД останутся в виде "осиротевших" страниц, которые можно очистить при помощи Server Manager, пункт меню Validate Database, или в виде "мусорных" версий записей, которые будут автоматически очищены при очередном чтении данных.
Вполне возможно, что этот вопрос вызван тем, что восстановление состояния БД в IB отличается от других широкораспространенных SQL-серверов (Oracle, Informix, ...). IB не требует выполнения каких-то специфических действий для продолжения работы с БД в случае сбоя питания - изменения, происходящие до COMMIT, не записываются на место актуальных данных (т.е. отсутствует режим Dirty Read), поэтому они будут просто потеряны, а БД останется в рабочем состоянии.
; Примечание: считается что транзакция - логический блок действий, переводящий БД из одного целостного состояния в другое. Поэтому даже если сервер позволяет восстановить uncommitted изменения, то делать этого не стоит.
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02915
Category:Базы данных
Category:Interbase
За какое время было создано изображение

=== За какое время было создано изображение ===
WEB сайт: http://program.dax.ru 
При нажатии на Button1 используется свойство Pixels, а при нажатии на Button2 - ScanLine. В заголовок окна выводится время в миллисекундах, за которое было создано изображение. 
procedure TForm1.Button1Click(Sender: TObject);
var
 t: cardinal;
 x, y: integer;
 bm: TBitmap;
begin
 bm := TBitmap.Create;
 bm.PixelFormat := pf24bit;
 bm.Width := Form1.ClientWidth;
 bm.Height := Form1.ClientHeight;
 t := GetTickCount;
 for y := 0 to bm.Height - 1 do
 for x := 0 to bm.Width - 1 do
 bm.Canvas.Pixels[x,y] := RGB(x+y, x-y, y-x);
 Form1.Caption := IntToStr(GetTickCount - t);
 Form1.Canvas.Draw(0, 0, bm);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 t: cardinal;
 x, y: integer;
 bm: TBitmap;
 p: PByteArray;
begin
 bm := TBitmap.Create;
 bm.PixelFormat := pf24bit;
 bm.Width := Form1.ClientWidth;
 bm.Height := Form1.ClientHeight;
 t := GetTickCount;
 for y := 0 to bm.Height - 1 do
 begin
 p := bm.ScanLine[y];
 for x := 0 to bm.Width - 1 do
 begin
 p^[x*3] := x+y;
 p^[x*3+1] := x-y;
 p^[x*3+2] := y-x;
 end;
 end;
 Form1.Caption := IntToStr(GetTickCount - t);
 Form1.Canvas.Draw(0, 0, bm);
end;
Source: http://delphiworld.narod.ru
ID: 00775
Завершение всех работающих приложений

=== Завершение всех работающих приложений ===
Как мне завершить все работающие задачи?
Ниже приведен код, который поможет вам завершить ВСЕ задачи без всяких уведомлений о необходимости сохранения данных.
Поэтому, прежде чем запустить этот код, убедитесь в наличии сохраненных данных и в том, что пользователь осведомлен об этой операции.
procedure TForm1.ButtonKillAllClick(Sender: TObject);
var
 pTask: PTaskEntry;
 Task: Bool;
 ThisTask: THANDLE;
begin
 GetMem(pTask, SizeOf(TTaskEntry));
 pTask^.dwSize := SizeOf(TTaskEntry);
 Task := TaskFirst(pTask);
 while Task do
 begin
 if pTask^.hInst = hInstance then
 ThisTask := pTask^.hTask
 else
 TerminateApp(pTask^.hTask, NO_UAE_BOX);
 Task := TaskNext(pTask);
 end;
 TerminateApp(ThisTask, NO_UAE_BOX);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02147