nyuuzyou/wikis huggingface dataset:
Как использовать свой диалог ввода пароля BDE?

=== Как использовать свой диалог ввода пароля BDE? ===
type
 TFormMain = class(TForm)
 public
 { Public declarations }
 procedure Password(Sender: TObject; var Continue: Boolean);
 end;
var
 FormMain: TFormMain;
implementation
{$R *.dfm}
procedure TFormMain.Password(Sender: TObject; var Continue: Boolean);
var
 Passwd: string[15];
begin
 Passwd := ;
 // Creating dialog
 FormPasswd := TFormPasswd.Create(Application);
 try
 if (FormPasswd.ShowModal = ID_OK) then
 begin
 // If OK is pressed then get password from edit "edPassword"
 Passwd := FormPasswd.edPasswd.Text
 end
 else
 begin
 // If Cancel is pressed then terminate application
 Application.ShowMainForm := False;
 Application.Terminate;
 Exit;
 end;
 finally
 // finally free password form
 FormPasswd.Free;
 end;
 Continue := (Passwd > );
 // Add password typed to session
 Session.AddPassword(Passwd);
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
 // Remove all typed passwords from session, so user need type password again in app start
 ClientDatabase.Session.RemoveAllPasswords;
// Undocument next row in debug mode. This is for debugging and testing only, so we don't need typing password again and again ...
// ClientDatabase.Session.AddPassword('YOUR-PASSWORD');
 ClientDatabase.Session.OnPassword := Password; // Set OnPassword Event
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02528
Как использовать файлы справки?

{ First we need to tell the Application object the name
 of the Help file and where to locate it. }
Application.HelpFile := ExtractFilePath(Application.ExeName) + 'YourHelpFile.hlp';
{ To Show a help file's content tab: }
Application.HelpCommand(HELP_CONTENTS, 0);
{ To display a specific topic of your help file: }
Application.HelpJump('TApplication_HelpJump');
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04543
----
Вот код для трех стандартных пунктов меню "Help":
procedure TForm1.Contents1Click(Sender: TObject);
begin
 Application.HelpCommand(HELP_CONTENTS, 0);
end;
procedure TForm1.SearchforHelpOn1Click(Sender: TObject);
begin
 Application.HelpCommand(HELP_PARTIALKEY, 0);
end;
procedure TForm1.HowtoUseHelp1Click(Sender: TObject);
begin
 Application.HelpCommand(HELP_HELPONHELP, 0);
end;
Source: http://delphiworld.narod.ru
ID: 04544
Category:Разработка приложений
Category:Справочная система
Как использовать форму из DLL

=== Как использовать форму из DLL ===
library Form;
uses
 Classes,
 Unit1 in 'Unit1.pas' {Form1};
exports
 CreateMyForm,
 DestroyMyForm;
end.
Это его Unit1: 
unit Unit1;
interface
// раздел uses и определение класса Form1
 procedure CreateMyForm(AppHandle: THandle); stdcall;
 procedure DestroyMyForm; stdcall;
implementation
{$R *.DFM}
procedure CreateMyForm(AppHandle: THandle);
begin
 Application.Handle := AppHandle;
 Form1 := TForm1.Create(Application);
 Form1.Show
end;
procedure DestroyMyForm;
begin
 Form1.Free;
end;
end.
Это UnitCall вызывающего EXE-шника: 
unit
 UnitCall;
interface
// раздел uses и определение класса Form1
 procedure CreateMyForm(AppHandle: THandle); stdcall; external 'Form.dll';
 procedure DestroyMyForm; stdcall; external 'Form.dll';
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
 CreateMyForm(Application.Handle);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 DestroyMyForm;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 00435
Как клонировать процесс?

{
 In Linux it is possible to duplicate a process with fork. In the original
 process, fork will return the handle to the duplicated process. The
 duplicated process will return zero.
}
program TestFork;
{$APPTYPE CONSOLE}
uses
 SysUtils,
 Libc;
var
 ForkedProcessHandle: __pid_t;
 bForked: Boolean;
procedure ForkNow;
begin
 bForked := true;
 ForkedProcessHandle := fork;
end;
function IsForked: Boolean;
begin
 Result := (ForkedProcessHandle = 0) and bForked;
end;
var
 Lf: Integer;
begin
 sigignore(SIGCHLD);
 bForked := false;
 WriteLn('do some stuff');
 WriteLn('before fork');
 ForkNow;
 WriteLn('after fork - we have dublicated the process');
 if IsForked then
 begin
 WriteLn('do some stuff in forked process (wait 5s)');
 for Lf := 0 to 50 do
 begin
 Write('f');
 sleep(100);
 end;
 end
 else
 begin
 WriteLn('do stuff in original process (wait 10)');
 for Lf := 0 to 100 do
 begin
 Write('o');
 sleep(100);
 end;
 end;
 WriteLn;
 if IsForked then
 WriteLn('forked process end')
 else
 WriteLn('original process end');
end.
{
Output of this demo app:
do some stuff
before fork
after fork - we have dublicated the process
after fork - we have dublicated the process
do some stuff in forked process (wait 5s)
fdo stuff in original process (wait 10)
ooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooffooff
ooffooffooffooffooffooffooffoo
forked process end
ooooooooooooooooooooooooooooooooooooooooooooooooo
original process end
}
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04616
Category:Kylix
Как конвертировать RGB в TColor

function RGBToColor(R, G, B: Byte): TColor;
begin
 Result := (B shl 16) or (G shl 8) or R;
end;
Source: http://forum.sources.ru
ID: 03683
----
RGB -> TColor
 RGB(r, g, b: Byte): TColor
TColor -> RGB
 GetRValue(Color: TColor)
 GetGValue(Color: TColor)
 GetBValue(Color: TColor)
Author: Vit
Source: http://forum.vingrad.ru
ID: 03684
Category:Графика
Category:Цвета и палитры
Как конвертировать WideString в String?

{:Converts Unicode string to Ansi string using specified code page.
 @param ws Unicode string.
 @param codePage Code page to be used in conversion.
 @returns Converted ansi string.
}
function WideStringToString(const ws: WideString; codePage: Word): AnsiString;
var
 l: Integer;
begin
 if ws = ' then
 Result := '
 else
 begin
 l := WideCharToMultiByte(codePage,
 WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
 @ws[1], - 1, nil, 0, nil, nil);
 SetLength(Result, l - 1);
 if l > 1 then
 WideCharToMultiByte(codePage,
 WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,
 @ws[1], - 1, @Result[1], l - 1, nil, nil);
 end;
end; { WideStringToString }
{:Converts Ansi string to Unicode string using specified code page.
 @param s Ansi string.
 @param codePage Code page to be used in conversion.
 @returns Converted wide string.
}
function StringToWideString(const s: AnsiString; codePage: Word): WideString;
var
 l: Integer;
begin
 if s = ' then
 Result := '
 else
 begin
 l := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PChar(@s[1]), - 1, nil, 0);
 SetLength(Result, l - 1);
 if l > 1 then
 MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PChar(@s[1]),
 - 1, PWideChar(@Result[1]), l - 1);
 end;
end; { StringToWideString }
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04289
Category:Конвертация
Category:Работа с текстом
Как конвертировать виртуальную клавишу в ASCII код?

=== Как конвертировать виртуальную клавишу в ASCII код? ===
Получаем символ, соответствующий виртуальной клавише:
function GetCharFromVKey(vkey: Word): string;
var
 keystate: TKeyboardState;
 retcode: Integer;
begin
 Win32Check(GetKeyboardState(keystate));
 SetLength(Result, 2);
 retcode := ToAscii(vkey,
 MapVirtualKey(vkey, 0),
 keystate, @Result[1],
 0);
 case retcode of
 0: Result := ;
 1: SetLength(Result, 1);
 2: ;
 else
 Result := ;
 end;
end;
{ Использование: }
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 ShowMessage(GetCharFromVKey(Key));
end; 
Source: Взято из http://forum.sources.ru
ID: 01508
Как консольное приложение может узнать, что Винды завершаются?

=== Как консольное приложение может узнать, что Винды завершаются? ===
Все процессы получают сигналы CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT и CTRL_SHUTDOWN_EVENT. А делается это (грубо говоря :) так:
BOOL Ctrl_Handler( DWORD Ctrl )
{
 if( (Ctrl == CTRL_SHUTDOWN_EVENT) || (Ctrl == CTRL_LOGOFF_EVENT) )
 {
 // Вау! Юзер обламывает!
 }
 else
 {
 // Тут что-от другое можно творить. А можно и не творить :-)
 }
 return TRUE;
}
function Ctrl_Handler(Ctrl: Longint): LongBool;
begin
 if Ctrl in [CTRL_SHUTDOWN_EVENT, CTRL_LOGOFF_EVENT] then
 begin
 // Вау, вау
 end
 else
 begin
 // Am I creator?
 end;
 Result := true;
end;
А где-то в программе:
 SetConsoleCtrlHandler(Ctrl_Handler, TRUE);
Таких обработчиков можно навесить кучу. Если при обработке какого-то из сообщений обработчик возвращает FALSE, то вызывается следующий обработчик. Можно настроить таких этажерок, что ого-го :-)))
Короче, смотри описание SetConsoleCtrlHandler -- там всё есть.
Author: Nomadic
Source: Взято с http://delphiworld.narod.ru
ID: 02191
Как копировать/менять Clipboard text без использования VCL?

=== Как копировать/менять Clipboard text без использования VCL? ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 function GetClipBoardText: string;
 procedure SetClipBoardText(const Value: string);
 procedure Open;
 procedure SetBuffer(Format: Word; var Buffer; Size: Integer);
 procedure Adding;
 procedure Clear;
 constructor CreateRes(Ident: Integer);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 FOpenRefCount: Integer;
 FClipboardWindow: HWND;
 FAllocated: Boolean;
 FEmptied: Boolean;
 FMessage: string;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
resourcestring
 SCannotOpenClipboard = 'Cannot open clipboard';
implementation
{$R *.dfm}
// Create resource for resourceString
constructor TForm1.CreateRes(Ident: Integer);
begin
 FMessage := LoadStr(Ident);
end;
// Status: Adding
procedure TForm1.Adding;
begin
 if (FOpenRefCount <> 0) and not FEmptied then
 begin
 Clear;
 FEmptied := True;
 end;
end;
// Empty clipboard
procedure TForm1.Clear;
begin
 Open;
 try
 EmptyClipboard;
 finally
 Close;
 end;
end;
// Set buffer
procedure TForm1.SetBuffer(Format: Word; var Buffer; Size: Integer);
var
 Data: THandle;
 DataPtr: Pointer;
begin
 Open;
 try
 Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, Size);
 try
 DataPtr := GlobalLock(Data);
 try
 Move(Buffer, DataPtr^, Size);
 Adding;
 SetClipboardData(Format, Data);
 finally
 GlobalUnlock(Data);
 end;
 except
 GlobalFree(Data);
 raise;
 end;
 finally
 Close;
 end;
end;
// Open the clipboard
procedure TForm1.Open;
begin
 if FOpenRefCount = 0 then
 begin
 FClipboardWindow := Application.Handle;
 if FClipboardWindow = 0 then
 begin
 {$IFDEF MSWINDOWS}
 FClipboardWindow := Classes.AllocateHWnd(MainWndProc);
 {$ENDIF}
 {$IFDEF LINUX}
 FClipboardWindow := WinUtils.AllocateHWnd(MainWndProc);
 {$ENDIF}
 FAllocated := True;
 end;
 if not OpenClipboard(FClipboardWindow) then
 raise Exception.CreateRes(@SCannotOpenClipboard);
 FEmptied := False;
 end;
 Inc(FOpenRefCount);
end;
// Get the clipboard text
function TForm1.GetClipBoardText: string;
var
 Data: THandle;
begin
 Open;
 Data := GetClipboardData(CF_TEXT);
 try
 if Data <> 0 then
 Result := PChar(GlobalLock(Data))
 else
 Result := ;
 finally
 if Data <> 0 then GlobalUnlock(Data);
 Close;
 end;
end;
procedure TForm1.SetClipBoardText(const Value: string);
begin
 // Set ClipboardText
 SetBuffer(CF_TEXT, PChar(Value)^, Length(Value) + 1);
end;
// Get the clipboard text
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetClipboardText);
end;
// Set the clipboard text
procedure TForm1.Button2Click(Sender: TObject);
begin
 SetClipboardText('-> Big-X <-');
end;
end.
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01903
----
Как скопировать содержимое строки в буфер обмена?
ID: 01904
Как копировать векторное изображение?

=== Как копировать векторное изображение? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 mf: TMetaFile;
 mfc: TMetaFileCanvas;
 i: integer;
 ClipBrdFormat: word;
 data: cardinal;
 palette: hPalette;
 p: array [0..90] of TPoint;
begin
 mf := TMetaFile.Create;
 mf.Width := 100;
 mf.Height := 100;
 mfc := TMetafileCanvas.Create(mf, 0);
 with mfc do
 begin
 Pen.Color := clBlack;
 FrameRect(ClipRect);
 MoveTo(0, 50);
 LineTo(100, 50);
 LineTo(95, 48);
 MoveTo(100, 50);
 LineTo(95, 52);
 MoveTo(50, 100);
 LineTo(50, 0);
 LineTo(48, 5);
 MoveTo(50, 0);
 LineTo(52, 5);
 Brush.Style := bsClear;
 Font.name := 'arial';
 Font.Size := 6;
 TextOut(55, 0, 'Y');
 TextOut(95, 38, 'X');
 Pen.Color := clRed;
 for i := low(p) to high(p) do
 p[i] := Point(i, round(50 - 30 * sin((i - 50) / 5)));
 Polyline(p);
 end;
 mfc.Free;
 mf.SaveToClipboardFormat(ClipBrdFormat, data, palette);
 OpenClipboard(Application.Handle);
 EmptyClipboard;
 SetClipboardData(ClipBrdFormat, data);
 CloseClipboard;
 mf.Inch := 200;
 Form1.Canvas.Draw(0, 0, mf);
 mf.Free;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01907
Как копировать и вставлять TreeNode?

=== Как копировать и вставлять TreeNode? ===
var
 SL: TStringList;
procedure TForm1.CutBtnClick(Sender: TObject);
var
 i, j, StartLevel : integer;
 TNSel : TTreeNode;
begin
 TNSel := TreeView1.Selected;
 if TNSel <> nil then
 begin
 StartLevel := TNSel.Level;
 i := TNSel.AbsoluteIndex;
 j := i; // note for later deletion
 if SL = nil then
 SL := TStringList.Create
 else
 SL.Clear;
 SL.AddObject(TNSel.Text, pointer(0));
 Inc(i);
 with TreeView1 do
 begin
 while Items[i].Level > StartLevel do
 begin
 { stop before next sibling to top node }
 SL.AddObject(Items[i].Text, Pointer(Items[i].Level - StartLevel));
 Inc(i);
 end;
 Items[j].Delete;
 end;
 end;
end;
procedure TForm1.PasteBtnClick(Sender: TObject);
var
 i, Level : integer;
 TNSel, TN : TTreeNode;
begin
 with TreeView1 do
 begin
 TNSel := Selected;
 if TNSel <> nil then
 begin
 TN := Items.Insert(TNSel, SL.Strings[0]);
 Level := integer(SL.Objects[0]); // should be 0
 for i := 1 to SL.Count - 1 do
 begin
 if Integer(SL.Objects[i]) < Level then
 begin
 { go up one level }
 TN := TN.Parent;
 Level := integer(SL.Objects[i]);
 end;
 if Level = integer(SL.Objects[i]) then
 { same level }
 TN := Items.Add(TN, SL.Strings[i])
 else
 begin
 { go down one level }
 TN := Items.AddChild(TN, SL.Strings[i]);
 Level := integer(SL.Objects[i]);
 end;
 end;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00628
Как копировать и удалять таблицы?

=== Как копировать и удалять таблицы? ===
Here is an example of a routine that I use for copying and deleting tables. It uses DB, DBTables, DbiProcs,DbiErrs, and DbiTypes.
You simply provide the directory to copy from, the source table name, the directory to copy to, and the destination table name, and the BDE will copy the entire table, indexes and all to the new file.
The delete function takes the path to delete from and the name of the table to delete, the BDE takes care of deleting all associated files (indexes, etc.).
These procedures have been pulled off a form of mine, and I've edited them to remove some dependencies that existed with that form. They should now be completely stand-alone.
procedure TConvertForm.CopyTable(FromDir, SrcTblName, ToDir, DestTblName: string);
var
 DBHandle: HDBIDB;
 ResultCode: DBIResult;
 Src, Dest, Err: array[0..255] of Char;
 SrcTbl, DestTbl: TTable;
begin
 SrcTbl := TTable.Create(Application);
 DestTbl := TTable.Create(Application);
 try
 SrcTbl.DatabaseName := FromDir;
 SrcTbl.TableName := SrcTblName;
 SrcTbl.Open;
 DBHandle := SrcTbl.DBHandle;
 SrcTbl.Close;
 ResultCode := DbiCopyTable(DBHandle, false,
 StrPCopy(Src, FromDir + '\' + SrcTblName), nil,
 StrPCopy(Dest, ToDir + '\' + DestTblName));
 if ResultCode <> DBIERR_NONE then
 begin
 DbiGetErrorString(ResultCode, Err);
 raise EDatabaseError.Create('While copying ' +
 FromDir + '\' + SrcTblName + ' to ' +
 ToDir + '\' + DestTblName + ', the '
 + ' database engine generated the error '''
 + StrPas(Err) + ');
 end;
 finally
 SrcTbl.Free;
 DestTbl.Free;
 end;
end;
procedure TConvertForm.DeleteTable(Dir, TblName: string);
var
 DBHandle: HDBIDB;
 ResultCode: DBIResult;
 tbl, Err: array[0..255] of Char;
 SrcTbl, DestTbl: TTable;
begin
 SrcTbl := TTable.Create(Application);
 try
 SrcTbl.DatabaseName := Dir;
 SrcTbl.TableName := TblName;
 SrcTbl.Open;
 DBHandle := SrcTbl.DBHandle;
 SrcTbl.Close;
 ResultCode := DbiDeleteTable(DBHandle,
 StrPCopy(Tbl, Dir + '\' + TblName), nil);
 if ResultCode <> DBIERR_NONE then
 begin
 DbiGetErrorString(ResultCode, Err);
 raise EDatabaseError.Create('While deleting ' +
 Dir + '\' + TblName + ', the database ' +
 'engine generated the error + StrPas(Err) + ');
 end;
 finally
 SrcTbl.Free;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02607
Как копировать образ экрана в файл

На форме у меня стоит TImage (его можно сделать невидимым)
uses JPEG;
var
 ji: TJPEGImage;
 Dwh: HWND;
 DRect: TRect;
 DescDC: HDC;
 Canv: TCanvas;
begin
 ji := TJPEGImage.Create();
 try
 ji.CompressionQuality := 100;
 Image.Width := Screen.Width;
 Image.Height := Screen.Height;
 DWH := GetDesktopWindow();
 GetWindowRect(DWH, DRect);
 DescDC := GetDeviceContext(DWH);
 Canv.Handle := DescDC;
 DRect.Left := 0;
 DRect.Top := 0;
 DRect.Right := Screen.Width;
 DRect.Bottom := Screen.Height;
 Image.Canvas.CopyRect(DRect, Canv, DRect);
 ji.Assign(Image.Picture.Bitmap);
 ji.SaveToFile('M:\MyFile.jpg');
 finally
 ji.Free;
 end;
end;
Author: Vit
Source: http://forum.vingrad.ru
ID: 03818
Category:Графика
Category:Jpeg
Как корректно определить изменения в оборудовании PlugNPlay?

=== Как корректно определить изменения в оборудовании PlugNPlay? ===
type
 TForm1 = class(TForm)
 Button1: TButton;
 private
 { Private declarations }
 procedure WMDeviceChange(var Message: TMessage);
 message WM_DEVICECHANGE;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
const DBT_DEVICEARRIVAL = $8000;
const DBT_DEVICEQUERYREMOVE = $8001;
const DBT_DEVICEQUERYREMOVEFAILED = $8002;
const DBT_DEVICEREMOVEPENDING = $8003;
const DBT_DEVICEREMOVECOMPLETE = $8004;
const DBT_DEVICETYPESPECIFIC = $8005;
const DBT_CONFIGCHANGED = $0018;
procedure TForm1.WMDeviceChange(var Message: TMessage);
var
 s: string;
begin
 { Do Something here }
 case Message.wParam of
 DBT_DEVICEARRIVAL:
 s := 'A device has been inserted and is now available';
 DBT_DEVICEQUERYREMOVE: begin
 s := 'Permission to remove a device is requested';
 ShowMessage(s);
 { True grants premission }
 Message.Result := integer(true);
 exit;
 end;
 DBT_DEVICEQUERYREMOVEFAILED:
 s := 'Request to remove a device has been canceled';
 DBT_DEVICEREMOVEPENDING:
 s := 'Device is about to be removed';
 DBT_DEVICEREMOVECOMPLETE:
 s := 'Device has been removed';
 DBT_DEVICETYPESPECIFIC:
 s := 'Device-specific event';
 DBT_CONFIGCHANGED:
 s := 'Current configuration has changed'
 else
 s := 'Unknown Device Message';
 end;
 ShowMessage(s);
 inherited;
end;
ID: 01334
Как корректно прервать выполнение SQL-запроса?

=== Как корректно прервать выполнение SQL-запроса? ===
Дает ли Delphi возможность корректно прервать выполнение SQL-запроса к серверу Oracle с помощью BDE? Например, чтобы при использовании с SQL Plus после отправки SQL-запроса на выполнение на экране появлялось окно с кнопкой Cancel, которое давало бы возможность в любой момент прервать выполнение этого запроса?
Насколько мне известно, для этой цели лучше всего использовать функции Oracle Call Interface (низкоуровневый API Oracle). В комплекте поставки Oracle есть соответствующие примеры для C, и переписать их на Pascal несложно.
Некоторые драйверы SQL Link позволяют прекратить выполнение запроса, если время его выполнения превышает заранее заданное значение (параметр MAX QUERY TIME соответствующего драйвера). Однако драйвер ORACLE, к сожалению, в их число не входит.
Source: Взято с http://delphiworld.narod.ru
ID: 02725
Как локализовать (русифицировать) ресурсы какого-либо пакета (runtime package)?

:1) Вынимаете pесуpсы из этого модуля.
:2) Пеpеводите их на дpугой язык. (напpимеp pусский)
:3) Создаете в Delphi свой пpоект Dll-ки (с именем того модуля, из котоpого вы вынули pесуpсы, напpимеp vcl30), в котоpый включаете пеpеведенные pесуpсы:
 {$R vcl30rus.res}
:4) Собиpаете все это.
:5) Пеpеименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.
Если вы хотите, пpиложение "говоpило" по pусски только тогда, когда в pегиональных установках стоит Russia - то тогда это все.
Если же вы хотите, чтобы ваше пpиложение _всегда_ поднимало pусские pесуpсы, то необходимо сделать следующее добавление в Registry:
 HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales
 "X:\MyProject\MyApp.exe" = "rus"
Тепеpь, когда ваше пpиложение будет поднимать pakages, то всегда будут бpаться pусские pесуpсы. Дpугие пpиложения, напpимеp Delphi - это не затpонет.
Таким обpазом можно заменять даже DFM-ки из пpоекта.
Более подpобно об этом - см Help - Index - Localizing...
Author: Alexander Simonenko .alex@protec.kiev.ua.(2:463/249)
ID: 04555
Category:Разработка приложений
Как менять шрифт в RichEdit горячими клавишами?

=== Как менять шрифт в RichEdit горячими клавишами? ===
Следующий пример показывает, как можно изменять шрифт в компоненте TRichEdit при помощи следующих комбинаций клавиш:
 Ctrl + B - Включает и выключает жирность (Bold) шрифта
 Ctrl + I - Включает и выключает (Italic) шрифта
 Ctrl + S - Включает и выключает зачёркивание (Strikeout) шрифта
 Ctrl + U - Включает и выключает подчёркивание (Underline) шрифта
Замечание: Так же можно устанавливать сразу несколько типов шрифта.
Пример:
const
 KEY_CTRL_B = 02;
 KEY_CTRL_I = 9;
 KEY_CTRL_S = 19;
 KEY_CTRL_U = 21;
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
begin
 case Ord(Key) of
 KEY_CTRL_B:
 begin
 Key := #0;
 if fsBold in (Sender as TRichEdit).SelAttributes.Style then
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style - [fsBold] else
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style + [fsBold];
 end;
 KEY_CTRL_I:
 begin
 Key := #0;
 if fsItalic in 
 (Sender as TRichEdit).SelAttributes.Style then
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style - [fsItalic] 
 else
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style + [fsItalic];
 end;
 KEY_CTRL_S:
 begin
 Key := #0;
 if fsStrikeout in 
 (Sender as TRichEdit).SelAttributes.Style then
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style - [fsStrikeout] 
 else
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style + [fsStrikeout];
 end;
 KEY_CTRL_U:
 begin
 Key := #0;
 if fsUnderline in 
 (Sender as TRichEdit).SelAttributes.Style then
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style - [fsUnderline] 
 else
 (Sender as TRichEdit).SelAttributes.Style :=
 (Sender as TRichEdit).SelAttributes.Style + [fsUnderline];
 end;
 end;
end;
Source: Взято из http://forum.sources.ru
ID: 00564
Как мне избавиться от выскакивающего окна CPU при ошибках?

=== Как мне избавиться от выскакивающего окна CPU при ошибках? ===
 HKEY_CURRENT_USER\Software\Borland\Delphi\4.0\Debugging 
 ViewCPUOnException=0
Source: http://www.delphifaq.com
ID: 00014
Как мне отправить на принтер чистый поток данных?

Под Win16 Вы можете использовать функцию SpoolFile, или Passthrough escape, если принтер поддерживает последнее. Под Win32 Вы можете использовать WritePrinter.
Ниже пример открытия принтера и записи чистого потока данных в принтер. Учтите, что Вы должны передать корректное имя принтера, такое, как "HP LaserJet 5MP", чтобы функция сработала успешно.
Конечно, Вы можете включать в поток данных любые необходимые управляющие коды, которые могут потребоваться.
uses WinSpool;
procedure WriteRawStringToPrinter(PrinterName:String; S:String);
var
 Handle: THandle;
 N: DWORD;
 DocInfo1: TDocInfo1;
begin
 if not OpenPrinter(PChar(PrinterName), Handle, nil) then
 begin
 ShowMessage('error ' + IntToStr(GetLastError));
 Exit;
 end;
 with DocInfo1 do begin
 pDocName := PChar('test doc');
 pOutputFile := nil;
 pDataType := 'RAW';
 end;
 StartDocPrinter(Handle, 1, @DocInfo1);
 StartPagePrinter(Handle);
 WritePrinter(Handle, PChar(S), Length(S), N);
 EndPagePrinter(Handle);
 EndDocPrinter(Handle);
 ClosePrinter(Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 WriteRawStringToPrinter('HP', 'Test This');
end;
(Borland FAQ N714, переведен Акжаном Абдулиным)
Source: Взято с сайта http://blackman.wp-club.net/
ID: 03224
Category:Принтер