nyuuzyou/wikis huggingface dataset:
Как из RXRichEdit сохранить в RTF формате?

=== Как из RXRichEdit сохранить в RTF формате? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 t: TFileStream;
begin
 t := TFileStream.Create('c:\myfilename.txt', fmCreate or fmOpenWrite);
 try
 t.Size := 0;
 RxRichEdit1.Lines.SaveToStream(t);
 finally
 t.Free;
 end;
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00570
Как избавиться от ошибки multiple rows in singleton select?

=== Как избавиться от ошибки multiple rows in singleton select? ===
Очевидно что данная ошибка происходит в вашем триггере или хранимой процедуре. Обычный SELECT внутри триггера или процедуры должен возвращать одну строку (row), т.к. при двух и более строках IB не знает куда поместить значения полей этих строк. Если ваш SELECT возвращает несколько записей, то нужно пользоваться конструкцией FOR SELECT ... INTO ... DO ... которая производит обработку возвращаемого набора записей в цикле.
Если-же вы уверены, что ваш SELECT должен вернуть только одну запись, а ошибка все-таки возникает, то давайте рассмотрим следующую ситуацию:
* существуют таблицы ORDERS (заказы) и CLIENTS (клиенты).
* обе эти таблицы имеют поле связи CLIENT_ID INTEGER.
для того чтобы вытащить информацию о клиенте используется запрос:
SELECT CLIENT_ID, CLIENT_NAME
FROM CLIENTS
WHERE CLIENT_ID = ?
где ? - либо значение либо переменная.
Теперь представим себе, что этот запрос должен выполняться в триггере при вставке записи в таблицу ORDERS
CREATE TRIGGER TI_ORDERS FOR ORDERS
ACTIVE AFTER INSERT POSITION 0
AS
DECLARE VARIABLE CID INTEGER;
DECLARE VARIABLE CNAME CHAR(30);
BEGIN
 SELECT C.CLIENT_ID, C.CLIENT_NAME
 FROM CLIENTS C
 WHERE C.CLIENT_ID = CLIENT_ID
 INTO :CID, :CNAME;
 ...
Итак, поскольку в запросе использован псевдоним C (FROM CLIENTS C), то якобы существует гарантия что в предложении WHERE будут сравниваться поле C.CLIENT_ID из таблицы CLIENTS и поле CLIENT_ID из таблицы ORDERS (в триггере доступны имена полей собственной таблицы). На самом деле даже использование псевдонимов не дает гарантии что переменные будут разичаться, и получается что в предложении WHERE сравнивается само с собой поле таблицы CLIENTS.CLIENT_ID, и в запросе возвращается ВСЯ таблица CLIENTS.
Вот почему возникает вышеупомянутое сообщение об ошибке.
Избавиться от него можно несколькими путями:
* Использовать разные имена полей для связи между CLIENTS и ORDERS. например OCLIENT_ID и CCLIENT_ID.
* Использовать уточнитель new.CLIENT_ID, несмотря на то что в документации указано что для триггеров последействия (AFTER) он не имеет смысла.
SELECT C.CLIENT_ID, C.CLIENT_NAME
FROM CLIENTS C
WHERE C.CLIENT_ID = new.CLIENT_ID
-- ...
Перед запросом поместить CLIENT_ID в локальную переменную, и в запросе использовать сравнение не с полем, а с этой локальной переменной.
CID=CLIENT_ID;
SELECT C.CLIENT_ID, C.CLIENT_NAME
FROM CLIENTS C
WHERE C.CLIENT_ID = :CID
-- ...
Author: Дмитрий Кузьменко
Source: http://www.ibase.ru/
ID: 02887
Category:Базы данных
Category:Interbase
Как извлечь иконку из EXE или DLL?

=== Как извлечь иконку из EXE или DLL? ===
Такой вот совет пришел ко мне с рассылкой "Ежедневная рассылка сайта Мастера DELPHI", думаю многим будет интересно.
Решить эту задачу нам поможет функция
 function ExtractIcon(hInstance, filename, iconindex): Integer
* hinstance - глобальная переменная приложения, ее изменять не надо. Тип integer.
* filename - имя программы или DLL из которой надо извлекать иконки. Тип pchar.
* iconindex - порядковый номер иконки в файле (начинается с 0). В одном файле может находится несколько иконок. Тип integer.
Функция находится в модуле ShellApi, так что не забудьте подключить его в uses. Если эта функция возвратит ноль, значит иконок в файле нет.
Данная функция возвращает handle иконки, поэтому применять ее нужно так:
 Image1.Picture.Icon.Handle := ExtractIcon(hInstance, PChar(ParamStr(0)), 0);
данное объявление нарисует в Image'e картинку вашего приложения.
Author: Михаил Христосенко
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02154
----
Функция ExtractIcon позволяет извлечь иконку из exe, dll и ico-файлов. Если указанная иконка отсутствует, функция возвращает 0. Количество иконок, содержащихся в файле, можно узнать, указав в качестве последнего параметра -1.
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
 ic: TIcon;
 i, count: Integer;
 w: Integer;
begin
 if not OpenDialog1.Execute then Exit;
 Form1.Canvas.FillRect(Form1.Canvas.ClipRect);
 count := ExtractIcon(Application.Handle, PChar(OpenDialog1.FileName), -1);
 ic := TIcon.Create;
 w := Form1.Width div 32;
 for i := 0 to count - 1 do
 begin
 ic.Handle := ExtractIcon(Application.Handle, PChar(OpenDialog1.FileName), i);
 Form1.Canvas.Draw(32 * (i mod w), 32 * (i div w), ic);
 end;
 ic.Destroy;
end;
 Автор советов: Даниил Карапетян
 e-mail: delphi4all@narod.ru
 
 Автор справки: Алексей Денисов
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: Алексей Денисов
ID: 02155
Как изменить громкость?

=== Как изменить громкость? ===
procedure SetVolume(X: Word);
var
 iErr: Integer;
 i: Integer;
 a: TAuxCaps;
begin
 for i := 0 to auxGetNumDevs do
 begin
 auxGetDevCaps(i, Addr(a), SizeOf(a));
 if a.wTechnology = AUXCAPS_CDAUDIO then break;
 end;
 // Устанавливаем одинаковую громкость для левого и правого каналов.
 // VOLUME := LEFT*$10000 + RIGHT*1
 iErr := auxSetVolume(i, (X * $10001));
 if (iErr <> 0) then ShowMessage('No audio devices are available!');
end;
function GetVolume: Word;
var
 iErr: Integer;
 i: Integer;
 a: TAuxCaps;
 vol: Word;
begin
 for i := 0 to auxGetNumDevs do
 begin
 auxGetDevCaps(i, Addr(a), SizeOf(a));
 if a.wTechnology = AUXCAPS_CDAUDIO then break;
 end;
 iErr := auxGetVolume(i, Addr(vol));
 GetVolume := vol;
 if (iErr <> 0) then ShowMessage('No audio devices are available!');
end;
Source: Взято из http://forum.sources.ru
ID: 02251
Как изменить заголовок кнопки ПУСК

=== Как изменить заголовок кнопки ПУСК ===
Для начала создайте какой-нибудь Bitmap, который вы будете натягивать на кнопку [т.к. такого понятия как "заголовок кнопки ПУСК" в действительности не существует], а та надпись, что находится на стартовой кнопке, является рисунком. Создавая рисунок, учитывайте размеры и то, что левая сторона должна быть "плоской", как у нас на рисунке слева, это связано с особенностями наложения. 
Далее займёмся проектом. Сначала объявляем глобальные переменные 
var
 StartButton: hWnd;
 OldBitmap: THandle;
 NewImage: TPicture;
Затем описываем событие по создания окна [OnCreate]: 
procedure TForm1.FormCreate(Sender: TObject);
begin
 NewImage := TPicture.create;
 NewImage.LoadFromFile('C:\Windows\delphi.BMP'); // здесь укажите путь к нужному файлу
 StartButton := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
 OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle);
end;
Если вы делаете это на своей машине, то можете всё восстанавливать по событию OnDestroy: 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 SendMessage(StartButton, BM_SetImage, 0, OldBitmap);
 NewImage.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 01799
Как изменить значение свойства компонента по имени?

=== Как изменить значение свойства компонента по имени? ===
function GetProperty(AControl: TPersistent; AProperty: String): PPropInfo;
var
 i: Integer;
 props: PPropList;
 typeData: PTypeData;
begin
 Result := nil;
 if (AControl = nil) or (AControl.ClassInfo = nil) then
 Exit;
 typeData := GetTypeData(AControl.ClassInfo);
 if (typeData = nil) or (typeData^.PropCount = 0) then
 Exit;
 GetMem(props, typeData^.PropCount * SizeOf(Pointer));
 try
 GetPropInfos(AControl.ClassInfo, props);
 for i := 0 to typeData^.PropCount - 1 do
 begin
 with Props^[i]^ do
 if (Name = AProperty) then
 result := Props^[i];
 end;
 finally
 FreeMem(props);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 propInfo: PPropInfo;
begin
 PropInfo := GetProperty(Button1.Font, 'Name');
 if PropInfo <> nil then
 SetStrProp(Button1.Font, PropInfo, 'Arial');
end;
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00264
----
You can use RTTI to do this. Here is how to change a particular component:
procedure TForm1.BtnClick(Sender: TObject);
var
 p: PPropInfo;
 f: TFont;
begin
 f := TFont.Create;
 {Setup the font properties}
 f.Name := 'Arial';
 p := GetPropInfo(Sender.ClassInfo, 'Font');
 if Assigned(p) then
 SetOrdProp(Sender, p, Integer(f));
 f.Free;
end;
To get at all the forms loop through the Screen global variable. For each form loop through its Components list calling the above procedure (or something close). If you only create your components at design time that is it. If you create some at runtime and the owner is not the form, then for each component loop through its Components list recursively to get at all the owned components.
Author: Jeff Overcash
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00265
----
I am building a routine that checks our forms for validity before deploying them. I would like to use some kind of structure that tests if a component type has access to a certain property, something like: " if (self.Controls[b] has Tag) then ...". Can anyone offer suggestions?
Here's an example of setting a string property for a component if it exists and another for an integer property:
{
Copyright © 1999 by Delphi 5 Developer's Guide - Xavier Pacheco and Steve Teixeira
}
procedure SetStringPropertyIfExists(AComp: TComponent; APropName: String;
AValue: String);
var
 PropInfo: PPropInfo;
 TK: TTypeKind;
begin
 PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
 if PropInfo <> nil then
 begin
 TK := PropInfo^.PropType^.Kind;
 if (TK = tkString) or (TK = tkLString) or (TK = tkWString) then
 SetStrProp(AComp, PropInfo, AValue);
 end;
end;
procedure SetIntegerPropertyIfExists(AComp: TComponent; APropName: String;
AValue: Integer);
var
 PropInfo: PPropInfo;
begin
 PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
 if PropInfo <> nil then
 begin
 if PropInfo^.PropType^.Kind = tkInteger then
 SetOrdProp(AComp, PropInfo, AValue);
 end;
end;
Author: Xavier Pacheco
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00266
Как изменить изображение кнопки Пуск?

=== Как изменить изображение кнопки Пуск? ===
Пример из серии "Что можно сделать с рабочим столом". В общем, это обычный трюк с кнопкой "Пуск" (Start).
{ объявляем глобальные переменные } 
var 
 Form1: TForm1; 
 StartButton: hWnd; 
 OldBitmap: THandle; 
 NewImage: TPicture; 
{ добавляем следующий код в событие формы OnCreate } 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 NewImage := TPicture.create; 
 NewImage.LoadFromFile('C:\Windows\Circles.BMP'); 
 StartButton := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil); 
 OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle); 
end; 
{ Событие OnDestroy } 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
 SendMessage(StartButton, BM_SetImage, 0, OldBitmap); 
 NewImage.Free; 
end;
Source: Взято из http://forum.sources.ru
ID: 01795
Как изменить иконку на Tray?

=== Как изменить иконку на Tray? ===
После добавления иконки на Tray можно менять саму иконку, ToolTip и сообщение, посылаемое окну. Для этого необходимо заполнить экземпляр структуры NOTIFYICONDATA и вызвать функцию Shell_NotifyIcon() с параметром NIM_MODIFY и указателем на заполненный экземпляр структуры. При изменении иконки необходимо заполнить поля cbSize, hWnd, uID, uFlags и поля, отвечающие за параметры иконки, которые вы хотите менять. При этом uFlags должен содержать комбинацию флагов, описывающую поля, которые необходимо модифицировать.
Source: Взято из FAQ: http://blackman.km.ru/myfaq/cont4.phtml]http://blackman.km.ru/myfaq/cont4.phtml
ID: 01757
Как изменить имя компьютера?

=== Как изменить имя компьютера? ===
SetComputerName(PChar(Edit1.Text));
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01714
Как изменить кодовую страницу шрифта принтера?

uses Sysutils, Printers;
procedure TForm1.Button1Click(Sender: TObject);
var
 Dosya: TextFile
begin
 with Printer do
 begin
 AssignPrn(Dosya);
 Rewrite(Dosya);
 Printer.Canvas.Font.Name := 'Courier New';
 Printer.Canvas.Font.Style := [fsBold];
 Printer.Canvas.Font.Size := 18;
 //****for Turkish special characters
 Writeln(Dosya, '?ьi??ц?');
 //****set Font CharSet to Turkish(162)
 Printer.Canvas.Font.Charset := 162;
 Writeln(Dosya, '?ьi??ц?');
 CloseFile(Dosya);
 end;
end;
The following table lists the predefined constants provided for standard character sets:
type
 TFontCharset = 0..255;
Constant 	Value	Description
ANSI_CHARSET 	0 	ANSI characters.
DEFAULT_CHARSET 	1 	Font is chosen based solely on Name and Size. If the described font is not available on the system, Windows will substitute another font.
SYMBOL_CHARSET 	2 	Standard symbol set.
MAC_CHARSET 	77 	Macintosh characters. Not available on NT 3.51.
SHIFTJIS_CHARSET 	128 	Japanese shift-jis characters.
HANGEUL_CHARSET 	129 	Korean characters (Wansung).
JOHAB_CHARSET 	130 	Korean characters (Johab). Not available on NT 3.51
GB2312_CHARSET 	134 	Simplified Chinese characters (mainland china).
CHINESEBIG5_CHARSET	136 	Traditional Chinese characters (taiwanese).
GREEK_CHARSET 	161 	Greek characters. Not available on NT 3.51.
TURKISH_CHARSET 	162 	Turkish characters. Not available on NT 3.51
VIETNAMESE_CHARSET 	163 	Vietnamese characters. Not available on NT 3.51.
HEBREW_CHARSET 	177 	Hebrew characters. Not available on NT 3.51
ARABIC_CHARSET 	178 	Arabic characters. Not available on NT 3.51
BALTIC_CHARSET 	186 	Baltic characters. Not available on NT 3.51.
RUSSIAN_CHARSET 	204 	Cyrillic characters. Not available on NT 3.51.
THAI_CHARSET 	222 	Thai characters. Not available on NT 3.51
EASTEUROPE_CHARSET 	238 	Includes diacritical marks for eastern european countries. Not available on NT 3.51.
OEM_CHARSET 	255 	Depends on the codepage of the operating system.
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03203
Category:Принтер
Как изменить оконную процедуру для TForm?

=== Как изменить оконную процедуру для TForm? ===
Переопределите в подклассе TForm оконную процедуру WinProc класса. В примере оконная процедура переопределяется для того чтобы реагировать на сообщение WM_CANCELMODE, показывающее, что выполняется messagebox или какой-либо еще диалог. 
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure WndProc(var Message: TMessage); override;
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WndProc(var Message: TMessage);
begin
 if Message.Msg = WM_CANCELMODE then
 begin
 Form1.Caption := 'A dialog or message box has popped up';
 end
 else
 inherited // <- остальное сделает родительская процедура
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage('Test Message');
end;
ID: 00420
Как изменить пароль для указанной сети или домена?

function NetUserChangePassword(Domain: PWideChar; UserName: PWideChar; OldPassword: PWideChar;
 NewPassword: PWideChar): Longint; stdcall; external 'netapi32.dll' name 'NetUserChangePassword';
// Changes a user's password for a specified network server or domain.
// Requirements: Windows NT/2000/XP
// Windows 95/98/Me: You can use the PwdChangePassword function to change a user's
// Windows logon password on these platforms
procedure TForm1.Button1Click(Sender: TObject);
begin
 NetUserChangePassword(PWideChar(WideString('\\COMPUTER')),
 PWideChar(WideString('username')),
 PWideChar(WideString('oldpass')),
 PWideChar(WideString('newpass')));
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03309
Category:Связь
Как изменить порт для принтера?

uses
 WinSpool;
{ Function SetPrinterToPort
 Parameters :
 hPrinter: handle of printer to change, obtained from OpenPrinter
 port: port name to use, e.g. LPT1:, COM1:, FILE:
 Returns:
 The name of the previous port the printer was attached to.
 Description:
 Changes the port a printer is attached to using Win32 API functions.
 The changes made are NOT local to this process, they will affect all
 other processes that try to use this printer! It is recommended to set the
 port back to the old port returned by this function after
 the end of the print job.
 Error Conditions:
 Will raise EWin32Error exceptions if SetPrinter or GetPrinter fail.
 Created:
 21.10.99 by P. Below}
function SetPrinterToPort(hPrinter: THandle; const port: string): string;
var
 pInfo: PPrinterInfo2;
 bytesNeeded: DWORD;
begin
 { Figure out how much memory we need for the data buffer. Note that GetPrinter is
 supposed to fail with a specific error code here. The amount of memory will
 be larger than Sizeof(TPrinterInfo2) since variable amounts of data are appended
 to the record }
 SetLastError(NO_ERROR);
 GetPrinter(hPrinter, 2, nil, 0, @bytesNeeded);
 if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
 RaiseLastWin32Error;
 pInfo := AllocMem(bytesNeeded);
 try
 if not GetPrinter(hPrinter, 2, pInfo, bytesNeeded, @bytesNeeded) then
 RaiseLastWin32Error;
 with pInfo^ do
 begin
 Result := pPortname;
 pPortname := @port[1];
 end;
 if not SetPrinter(hPrinter, 2, pInfo, 0) then
 RaiseLastWin32Error;
 finally
 FreeMem(pInfo);
 end;
end;
function GetCurrentPrinterHandle: THandle;
var
 Device, Driver, Port: array[0..255] of Char;
 hDeviceMode: THandle;
begin
 Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
 if not OpenPrinter(@Device, Result, nil) then
 RaiseLastWin32Error;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 03205
----
uses Printers;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
 pDevice: pChar;
 pDriver: pChar;
 pPort: pChar;
 hDMode: THandle;
 PDMode: PDEVMODE;
begin
 if PrintDialog1.Execute then
 begin
 GetMem(pDevice, cchDeviceName);
 GetMem(pDriver, MAX_PATH);
 GetMem(pPort, MAX_PATH);
 Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
 Printer.SetPrinter(pDevice, PDriver, 'FILE:', hDMode);
 FreeMem(pDevice, cchDeviceName);
 FreeMem(pDriver, MAX_PATH);
 FreeMem(pPort, MAX_PATH);
 Printer.BeginDoc;
 Printer.Canvas.TextOut(100, 100, 'Delphi World Is Wonderful!');
 Printer.EndDoc;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03206
Category:Принтер
Как изменить размеры полигона?

type
 TPolygon = array of TPoint;
procedure ZoomPolygon(var Polygon: TPolygon; const Center: TPoint; const Scale: Double);
var
 I: Integer;
begin
 for I := 0 to High(Polygon) do
 begin
 Polygon[I].X := Round(Scale * (Polygon[I].X - Center.X) + Center.X);
 Polygon[I].Y := Round(Scale * (Polygon[I].Y - Center.Y) + Center.Y);
 end;
end;
Source: http://www.baltsoft.com/
ID: 03910
Category:Графика
Category:Рисование
Как изменить системное время?

=== Как изменить системное время? ===
Функция SetSystemTime(). 
Обрати внимание на привилегии. 
Author: podval
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01638
----
//**********************************************************
// Функция (раздел Public) SetPCSystemTime изменяет системную дату и время.
// Параметр(ы) : tDati Новая дата и время
// Возвращаемые значения: True - успешное завершение
// False - метод несработал
//************************************************************
function SetPCSystemTime(tDati: TDateTime): Boolean;
var
 tSetDati: TDateTime;
 vDatiBias: Variant;
 tTZI: TTimeZoneInformation;
 tST: TSystemTime;
begin
 GetTimeZoneInformation(tTZI);
 vDatiBias := tTZI.Bias / 1440;
 tSetDati := tDati + vDatiBias;
 with tST do
 begin
 wYear := StrToInt(FormatDateTime('yyyy', tSetDati));
 wMonth := StrToInt(FormatDateTime('mm', tSetDati));
 wDay := StrToInt(FormatDateTime('dd', tSetDati));
 wHour := StrToInt(FormatDateTime('hh', tSetDati));
 wMinute := StrToInt(FormatDateTime('nn', tSetDati));
 wSecond := StrToInt(FormatDateTime('ss', tSetDati));
 wMilliseconds := 0;
 end;
 SetPCSystemTime := SetSystemTime(tST);
end;
ID: 01639
----
Для изменения системного времени используется сложный способ (через строки).
DateTimeToSystemTime(tSetDati, Tst);
- работает быстрее и код короче
ID: 01640
----
procedure SetTime(Hour, Min, Sec, Hundreths: Byte); assembler;
asm
 mov ch, Hour
 mov cl, Min
 mov dh, Sec
 mov dl, Hundreths
 mov ah, $2d
 int $21
end;
procedure SetDate(Year: word; Month, Day: Byte); assembler;
asm
 mov cx, Year
 mov dh, Month
 mov dl, Day
 mov ah, $2b
 int $21
end;
Author: Pegas
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01641
----
Следующие несколько строк кода позволяют установить системную дату и время без использования панели управления. Дата и время устанавливаются двумя раздельными компонентами TDateTimePicker. Дата и время декодируются и передаются в API функцию.
Из значения часа вычитается 2 для установки правильного времени. (Примечание Vit: вычитается не 2 часа а разница с Гринвичем)
procedure TfmTime.btnTimeClick(Sender: TObject);
var
 vsys: _SYSTEMTIME;
 vYear, vMonth, vDay, vHour, vMin, vSec, vMm: Word;
begin
 DecodeDate(Trunc(dtpDate.Date), vYear, vMonth, vDay);
 DecodeTime(dtpTime.Time, vHour, vMin, vSec, vMm);
 vMm := 0;
 vsys.wYear := vYear;
 vsys.wMonth := vMonth;
 vsys.wDay := vDay;
 vsys.wHour := (vHour - 2);
 vsys.wMinute := vMin;
 vsys.wSecond := vSec;
 vsys.wMilliseconds := vMm;
 vsys.wDayOfWeek := DayOfWeek(Trunc(dtpDate.Date));
 SetSystemTime(vsys);
end;
Source: Взято из http://forum.sources.ru
ID: 01642
ID: 01644
----
function SetTime(DateTime:TDateTime): boolean;
var
 st: TSystemTime;
 ZoneTime: TTimeZoneInformation;
begin
 GetTimeZoneInformation(ZoneTime);
 DateTime:=DateTime+ZoneTime.Bias/1440;
 with st do
 begin
 DecodeDate(DateTime, wYear, wMonth, wDay);
 DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
 end;
 Result:=SetSystemTime(st);
end;
Source: http://delphiworld.narod.ru
ID: 01643
----
Как изменить стандартный цвет ProgressBar?

=== Как изменить стандартный цвет ProgressBar? ===
Самый простой способ, это изменить цветовую схему в свойствах экрана... 
А вот при помощи следующей команды можно разукрасить ProgressBar не изменяя системных настроек:
PostMessage(ProgressBar1.Handle, $0409, 0, clGreen); 
Вуаля! Теперь Progress Bar зелёный. Это всего лишь простой пример чёрной магии ;)
Source: Взято из http://forum.sources.ru
ID: 00524
----
uses 
 CommCtrl; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 // Set the Background color to teal 
 Progressbar1.Brush.Color := clTeal; 
 // Set bar color to yellow 
 SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clYellow); 
end;
Source: http://delphiworld.narod.ru/
ID: 00958
Как изменить фоновый цвет текста

Воспользуйтесь API функциями SetBkColor и TextOut. 
procedure TForm1.Button1Click(Sender: TObject);
var
 OldTextColor: TColorRef;
 OldBkColor: TColorRef;
 OldBkMode: Integer;
begin
 OldTextColor := SetTextColor(Form1.Canvas.Handle, clYellow);
 OldBkColor := SetBkColor(Form1.Canvas.Handle, clGreen);
 OldBkMode := SetBkMode(Form1.Canvas.Handle, OPAQUE);
 TextOut(Form1.Canvas.Handle, 20, 20, 'Delphi World - лучше всех! ;-)', 27);
 SetBkMode(Form1.Canvas.Handle, OldBkMode);
 SetBkColor(Form1.Canvas.Handle, OldBkColor);
 SetTextColor(Form1.Canvas.Handle, OldTextColor);
end;
Author: Олег Кулабухов 
Source: http://delphiworld.narod.ru
ID: 01945
ID: 03689
Category:Графика
Category:Работа с текстом
Category:Цвета и палитры
Как изменить фоновый цвет текста?

=== Как изменить фоновый цвет текста в различных строчках TListBox? ===
После того, как поместите TListBox на форму, необходимо изменить свойство Style в TListBox на lbOwnerDrawFixed. Если не изменить свойство Style, то событие OnDrawItem никогда не вызовется. Теперь поместите следующий код в обработчик события OnDrawItem Вашего TListBox:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 myColor: TColor;
 myBrush: TBrush; 
begin
 myBrush := TBrush.Create; 
 with (Control as TListBox).Canvas do
 begin
 if not Odd(Index) then
 myColor := clSilver
 else
 myColor := clYellow;
 myBrush.Style := bsSolid; 
 myBrush.Color := myColor; 
 Windows.FillRect(Handle, Rect, myBrush.Handle); 
 Brush.Style := bsClear; 
 TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]); 
 MyBrush.Free;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 00643