nyuuzyou/wikis huggingface dataset:
Правое выравнивание ячеек TStringGrid

=== Правое выравнивание ячеек TStringGrid ===
procedure TForm1.GridSumaDrawCell(Sender: TObject; ACol, ARow: Longint;
 ARect: TRect; State: TGridDrawState);
var
 dx: integer;
begin
 with (Sender as TStringGrid).Canvas do
 begin
 Font := GridSuma.Font;
 Pen.Color := clBlack;
 if (ACol = 0) or (ARow = 0) then
 begin
 { Рисуем заголовок }
 Brush.Color := clBtnFace;
 FillRect(ARect);
 TextOut(ARect.Left, ARect.Top, GridSuma.Cells[ACol, ARow])
 end
 else
 begin
 { Рисуем ячейку с правым выравниванием }
 Brush.Color := clWhite;
 FillRect(ARect);
 dx := TextWidth(GridSuma.Cells[ACol, ARow]) + 2;
 TextOut(ARect.Right - dx, ARect.Top, GridSuma.Cells[ACol, ARow])
 end
 end
end;
Source: http://delphiworld.narod.ru/
ID: 01072
----
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
 procedure WriteText(StringGrid: TStringGrid; ACanvas: TCanvas; const ARect: TRect;
 const Text: string; Format: Word);
 const
 DX = 2;
 DY = 2;
 var
 S: array[0..255] of Char;
 B, R: TRect;
 begin
 with Stringgrid, ACanvas, ARect do
 begin
 case Format of
 DT_LEFT: ExtTextOut(Handle, Left + DX, Top + DY,
 ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text), Length(Text), nil);
 DT_RIGHT: ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,
 ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),
 Length(Text), nil);
 DT_CENTER: ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2,
 Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,
 StrPCopy(S, Text), Length(Text), nil);
 end;
 end;
 end;
 procedure Display(StringGrid: TStringGrid; const S: string; Alignment: TAlignment);
 const
 Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
 begin
 WriteText(StringGrid, StringGrid.Canvas, Rect, S, Formats[Alignment]);
 end;
begin
 // Right-justify columns 0-2 
 // Spalten 0-2 rechts ausrichten. 
 if ACol in [0..2] then
 Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taRightJustify)
 // Center the first row 
 // Erste zeile zentrieren 
 if ARow = 0 then
 Display(StringGrid1, StringGrid1.Cells[ACol, ARow], taCenter)
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01074
Предопределённые константы условной компилляции

=== Предопределённые константы условной компилляции ===
==== Версии компилятора ====
 Ver80 - Дельфи 1 
 Ver90 - Дельфи 2 
 Ver93 - С Buider 1 
 Ver100 - Дельфи 3 
 Ver110 - С Buider 3 
 Ver120 - Дельфи 4 
 Ver125 - С Buider 4 
 Ver130 - Дельфи 5 
 Ver140 - Дельфи 6 
 Ver150 - Дельфи 7 
 Ver160 - Дельфи 8 
 KYLIX - Kylix 1
 KYLIX2 - Kylix 2
 KYLIX3 - Kylix 3
 KYLIX4 - Kylix 4
==== Платформа: (определена для Дельфи 6 и выше) ====
 Linux
 MSWindows
==== Среда разработки: ====
 DELPHI
 BCB
Source: http://forum.vingrad.ru
ID: 00012
Предотвратить запуск Screen Saver при работе программы

=== Предотвратить запуск Screen Saver при работе программы ===
interface
 private
 procedure AppMessage(var Msg: TMsg; var handled: Boolean);
 end;
implementation
procedure TForm1.AppMessage(var Msg: TMsg; var handled: Boolean);
begin
 if (Msg.Message = WM_SYSCOMMAND) and (Msg.wParam = SC_SCREENSAVE) then
 Handled := True;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.OnMessage := AppMessage;
end;
{
 Note: The Screensaver is only disabled during the lifespan of
 your application.
}
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02385
Предотвратить изменение ширины колонки для TListView

=== Предотвратить изменение ширины колонки для TListView ===
 private
 FListViewOldWndProc: TWndMethod;
 procedure ListViewNewWndProc(var Msg: TMessage);
 end;
{....}
implementation
uses
 CommCtrl;
procedure TForm1.FormCreate(Sender: TObject);
begin
 // Sichern der ursprunglichen WindowProc der Listview
 FListViewOldWndProc := ListView1.WindowProc;
 // Subclassing: Umleiten der WindowProc auf unsere eigene Procedur
 Listview1.WindowProc := ListViewNewWndProc;
end;
procedure TForm1.ListViewNewWndProc(var Msg: TMessage);
var
 hdn: ^THDNotify;
begin
 if Msg.Msg = WM_NOTIFY then
 begin
 hdn := Pointer(Msg.lParam);
 // Abfangen und loschen der HDN_BeginTrack Botschaft
 if (hdn.hdr.code = HDN_BeginTrackW) or (hdn.hdr.code = HDN_BeginTrackA) then
 Msg.Result := 1
 else
 FListViewOldWndProc(Msg);
 end
 // ansonsten Botschaft an die ursprungliche WindowProc weiterreichen
 else
 FListViewOldWndProc(Msg);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
 //vor dem Beenden Original WindowProc wiederherstellen
 ListView1.WindowProc := FlistViewOldWndProc;
 FListViewOldWndProc := nil;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01145
Предпросмотр/печать TRichEdit

=== Предпросмотр/печать TRichEdit ===
Чтобы вывести Rich Edit на любой канвас, нужно использовать стандартное сообщение EM_FORMATRANGE.
 lParam параметр этого сообщения содержит указатель на структуру TFormatRange.
Перед посылкой сообщения нужно заполнить эту структуру:
 hdc - контекст устройства, на который будет выводиться Rich Edit
 hdcTarget - контекст устройства, в соответствии с которым будет производиться форматирование текста
 rc - область, в которую будет выводиться Rich Edit. Единицы измерения - твипсы (twips). Twips = 1/1440 дюйма.
 rcPage - полная область вывода устройства (в твипсах)
 chrg - указывает диапазон выводимого текста
chrg.cpMin и chrg.cpMax - позиции символов, определяющие кусок текста (не включая сами cpMin и cpMax)...
function PrintRTFToBitmap(ARichEdit: TRichEdit; ABitmap: TBitmap): Longint;
var
 range: TFormatRange;
begin
 FillChar(Range, SizeOf(TFormatRange), 0);
 // Rendering to the same DC we are measuring.
 Range.hdc := ABitmap.Canvas.handle;
 Range.hdcTarget := ABitmap.Canvas.Handle;
 // Set up the page.
 Range.rc.left := 0;
 Range.rc.top := 0;
 Range.rc.right := ABitmap.Width * 1440 div Screen.PixelsPerInch;
 Range.rc.Bottom := ABitmap.Height * 1440 div Screen.PixelsPerInch;
 // Default the range of text to print as the entire document.
 Range.chrg.cpMax := -1;
 Range.chrg.cpMin := 0;
 // format the text
 Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
 // Free cached information
 SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end;
Следующий пример покажет, как вывести Rich Edit не только на любой канвас, но и также, как вывести только определённый кусок текста...
function PrintToCanvas(ACanvas: TCanvas; FromChar, ToChar: integer;
 ARichEdit: TRichEdit; AWidth, AHeight: integer): Longint;
var
 Range: TFormatRange;
begin
 FillChar(Range, SizeOf(TFormatRange), 0);
 Range.hdc := ACanvas.handle;
 Range.hdcTarget := ACanvas.Handle;
 Range.rc.left := 0;
 Range.rc.top := 0;
 Range.rc.right := AWidth * 1440 div Screen.PixelsPerInch;
 Range.rc.Bottom := AHeight * 1440 div Screen.PixelsPerInch;
 Range.chrg.cpMax := ToChar;
 Range.chrg.cpMin := FromChar;
 Result := SendMessage(ARichedit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
 SendMessage(ARichEdit.handle, EM_FORMATRANGE, 0,0);
end; 
А как вывести Rich-текст с фоновым рисунком ?
Рисуем по-отдельности фоновый рисунок и содержимое TRichEdit, а потом их соединяем...
procedure TForm1.Button2Click(Sender: TObject);
var
 Bmp: TBitmap;
begin
 Bmp := TBitmap.Create;
 bmp.Width := 300;
 bmp.Height := 300;
 PrintToCanvas(bmp.Canvas, 2, 5, RichEdit1, 300, 300);
 BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
 bmp.Canvas.Handle, 0, 0, srcAND);
 Image1.Repaint;
 bmp.Free;
end; 
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00580
Преобразование 3D-координат точки в 2D-координаты в перспективе

{ **** UBPFD *********** by kladovka.net.ru ****
>> Преобразование 3D-координат точки в 2D-координаты в перспективе
Процедура преобразует 3D-координаты точки в 2D-координаты на "картинной
плоскости" в перспективе. В качестве параметров процедура принимает
координаты точки в пространстве (X - горизонтальная перпендикулярно
лучу зрения, Y - горизонтальная вдоль луча зрения, Z - вертикальная)
начало координат - точка пересечения луча зрения с картинной плоскостью;
Height - высоту наблюдателя;
Basis - расстояние от наблюдателя до картинной плоскости;
результаты вычисления записываются в переменные XP и YP - координаты
точки на картинной плоскости.
Зависимости: нет
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov, 1995
Дата: 29 апреля 2002 г.
********************************************** }
procedure Perspective(const X, Y, Z, Height, Basis: Double; var XP, YP: Double);
var
 Den: Double;
begin
 Den := Y + Basis;
 if Abs(Den) < 1e-100 then
 Den := 1e-100;
 XP := Basis * X / Den;
 YP := (Basis * Z + Height * Y) / Den;
end;
Author: Dimka Maslov
ID: 04124
Category:Алгоритмы
Category:Графика
Category:Геометрия
Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки

=== Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Преобразование Unicode строк в DFM файлах Delphi 6 в Ansi строки.
При попытке открыть проект созданный в Delphi 6 из Delphi 5 возникает 
проблема с чтением DFM-файла. Проблема заключается в том, что Delphi5 
не может прочитать строки, записанные в формате Unicode (WideString). 
Данная функция переводит строки из DFM файла в формат ANSI, после чего
DFM файл читается в D5. Но при этом может возникнуть проблема, 
связанная с незнакомыми для D5 свойствами компонентов, которая, 
в свою очередь, решается игнорированием этих свойств.
Зависимости: Classes
Copyright: Alx2
Дата: 31 мая 2002 г.
********************************************** }
Procedure RemoveUnicodeFromDFM(Const Filename: String);
 Function isChanges(Const S: String; Var Res: String): Boolean;
 Var len: Integer;
 Function LexemSharp(Var K: Integer): Boolean; 
 Begin
 Result := (K < len) And (S[K] = '#');
 If Result Then
 Begin
 inc(K);
 While (K <= len) And (S[K] In ['0'..'9']) Do inc(K);
 End;
 End;
 Function LexemAp(Var K: Integer): Boolean;
 Begin
 Result := (K < len) And (S[K] = ');
 If Result Then
 Begin
 inc(K);
 While (K <= len) And (S[K] <> ') Do inc(K);
 If K <= len
 Then
 inc(K);
 End;
 End;
 Function Lexem(Var K: Integer; Var Str: String): Boolean;
 Var
 Start: Integer;
 ValS : String;
 Begin
 Result := False;
 Start := K;
 If LexemSharp(K) Then
 Begin
 ValS := Copy(S, Start + 1, K - Start - 1);
 Str := WideChar(StrToInt(ValS));
 Result := True;
 End
 Else
 If LexemAp(K) Then
 Begin
 Str := Copy(S, Start + 1, K - Start - 2);
 Result := True;
 End;
 End;
 Function Prepare(Var K: Integer): String;
 Var Str: String;
 WasLexem: Boolean;
 Begin
 Result := ;
 WasLexem := False;
 While Lexem(K, Str) Do
 Begin
 Result := Result + Str;
 WasLexem := True;
 End;
 If Result <> Then
 Result := ' + Result + ' + Copy(S, K, Length(S))
 Else
 If Not WasLexem Then
 Result := S
 Else
 Result := ';
 End;
 Function Min(A, B: Integer): Integer;
 Begin
 If A = 0 Then Result := B
 Else
 If B = 0 Then Result := A
 Else
 If A > B Then Result := B
 Else Result := A;
 End;
 Var
 StartIdx: Integer;
 Begin
 Result := False;
 StartIdx := Min(Pos('#', S), Pos(', S));
 If StartIdx > 0 Then
 Begin
 len := Length(S);
 While (StartIdx <= len) And (Not (S[StartIdx] In ['#', '])) Do inc(StartIdx);
 If StartIdx < len Then
 Begin
 Res := Copy(S, 1, StartIdx - 1) + Prepare(StartIdx);
 Result := True;
 End;
 End;
 End;
Var
 SList: TStringList;
 K : Integer;
 Res : String;
Begin
 SList := TStringList.Create;
 Try
 SList.LOADFROMFILE(Filename);
 For K := 0 To SList.Count - 1 Do
 If isChanges(SList[K], Res) Then
 SList[K] := Res;
 SList.SaveToFile(Filename);
 Finally
 SList.Free;
 End;
End; 
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
 K: Integer;
begin
 if OpenDialog1.Execute then
 for K := 0 to OpenDialog1.Files.Count - 1 do
 RemoveUnicodeFromDFM(OpenDialog1.Files[K]);
end; 
Author: Alx2
Source: http://kladovka.net.ru
ID: 00173
Преобразование даты, месяц прописью

=== Преобразование даты, месяц прописью ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование даты (месяц прописью)
Преобразование даты. Например: 23.02.02 преобразуется в 23 февраля 2002 года.
Зависимости: DecodeDate
Автор: mukha, mukha@vistcom.ru, Волгоград
Copyright: mukha
Дата: 17 ноября 2002 г.
***************************************************** }
function Monthstr(S: string): string;
const
 Mes: array[1..12] of string = ('января', 'февраля', 'марта', 'апреля',
 'мая', 'июня', 'июля', 'августа', 'сентября', 'октября', 'ноября',
 'декабря');
var
 Year, Month, Day: Word;
begin
 try
 StrToDate(S); // пр-ка правильности ввода даты
 DecodeDate(StrToDate(S), Year, Month, Day);
 Result := IntToStr(day);
 Result := Result + ' ' + Mes[Month];
 Result := result + ' ' + IntToStr(Year) + ' года';
 except
 raise
 Exception.Create('"' + s + '"' + ' - такой даты нет!');
 end;
end;
Source: http://delphibase.endimus.com
ID: 00761
Преобразование даты и времени в строковый вид YYYYMMDDHHNNSS и обратно

=== Преобразование даты и времени в строковый вид YYYYMMDDHHNNSS и обратно ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование даты-времени в строковый вид и обратно (yyyymmddhhnnss)
Иногда становится нужно хранить дату и время в виде yyyymmddhhnnss.
Так, по некоторым причинам, с ними порой легче общаться и сортировать.
Зависимости: Windows, StdCtrls, SysUtils
Автор: mfender, mfender@fromru.com, Майкоп
Copyright: mfender
Дата: 10 августа 2003 г.
***************************************************** }
function mfStringToDateTime(const mfDTStr: string): TDateTime;
// Возвращает значение TDateTime из входящей строки mfDTStr
// в формате YYYYMMDDHHMMSS
var
 Safe: string;
begin
 Safe := ShortDateFormat; //сохраняем формат даты
 ShortDateFormat := 'dd.mm.yyyy hh:nn:ss'; //придаем произвольный вид
 // формату даты-времени
 mfStringToDateTime := StrToDateTime(Copy(mfDTStr, 7, 2) + '.' +
 Copy(mfDTStr, 5, 2) + '.' +
 Copy(mfDTStr, 1, 4) + ' ' +
 Copy(mfDTStr, 9, 2) + ':' +
 Copy(mfDTStr, 11, 2) + ':' +
 Copy(mfDTStr, 13, 2));
 // Преобразуем, собственно, части строки в соответствующие
 // детали даты и времени
 ShortDateFormat := Safe; //возвращаем дате первоначальный вид
end;
function mfDateTimeToString(const Date: TDateTime): string;
//Возвращает строку в формате YYYYMMDDHHNNSS из входящей DateTime
begin
 mfDateTimeToString := FormatDateTime('yyyymmddhhnnss', Date); //No comments
end;
Source: http://delphiworld.narod.ru
ID: 00760
Преобразование иконок в Gliph-ы

=== Преобразование иконок в Gliph-ы ===
Вот небольшой пример того, как можно загрузить иконку, содержащуюся в файле EXE, в Glyph у SpeedButton, и как очистить этот самый Glyph.
unit Procs;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, StdCtrls, Buttons, ExtCtrls, ShellAPI;
procedure LlenaBoton(boton: TSpeedButton; Programa: string);
procedure LimpiaBoton(boton: TSpeedButton);
var
 { Botones de programas }
 Pic: TPicture;
 Fname: string;
 TempFile: array[0..255] of Char;
 Icon: TIcon;
implementation
uses ttotro;
procedure LlenaBoton(boton: TSpeedButton; Programa: string);
var
 NumFiles, NameLength: integer;
 nIconsInFile: word;
 rBoton: TRect;
 oBitmap: TBitmap;
 oBitmap2: TBitmap;
 NombreBitmap: string;
begin
 try
 screen.cursor := crHourglass;
 { Extrae el Icono }
 Icon := TIcon.Create;
 StrPCopy(TempFile, Programa);
 Icon.Handle := ExtractIcon(HInstance, TempFile, 0);
 { Crea una instancia de TPicture }
 Pic := TPicture.Create;
 { Asigna el icon.handle a la propiedad Pic.icon }
 Pic.Icon := Icon;
 { Configura el tamano del bitmap como el del icono y el del segundo
 bitmap con el tamano del boton }
 oBitmap := TBitMap.Create;
 oBitmap2 := TBitMap.Create;
 oBitmap2.Width := Icon.Width;
 oBitmap2.Height := Icon.Height;
 oBitmap.Width := boton.Width - 4;
 oBitmap.Height := boton.Height - 4;
 { Dibuja el icono en el bitmap }
 oBitmap2.Canvas.Draw(0, 0, Pic.Graphic);
 rBoton.left := 1;
 rBoton.Top := 1;
 rBoton.right := boton.Width - 6;
 rBoton.Bottom := boton.Height - 6;
 oBitmap.Canvas.StretchDraw(rBoton, oBitmap2);
 Boton.Hint := Programa;
 NombreBitmap := Copy(programa, 1, Length(programa) - 3) + 'BMP';
 { Salva el bitmap en un fichero }
 if not FileExists(NombreBitmap) then
 begin
 oBitmap.SaveToFile(ExtractFilePath(Application.ExeName) +
 ExtractFileName(NombreBitmap));
 Boton.Glyph := oBitmap;
 end
 else
 { Carga el BMP en el boton }
 Boton.Glyph.LoadFromFile(ExtractFilePath(Application.ExeName) +
 ExtractFileName(NombreBitmap));
 finally
 Icon.Free;
 oBitmap.Free;
 oBitmap2.Free;
 screen.cursor := crDefault;
 end;
end;
procedure LimpiaBoton(boton: TSpeedButton);
var
 oBitmap: TBitmap;
 rBoton: TRect;
begin
 try
 { Configuara el tamano del bitmap como el del icono y el del segundo
 bitmap con el tamano del boton }
 oBitmap := TBitMap.create;
 oBitmap.Width := boton.Width - 4;
 oBitmap.Height := boton.Height - 4;
 Boton.Glyph := oBitmap;
 finally
 oBitmap.Free;
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 02367
ID: 04309
Category:Форматы файлов
Category:Bitmap
Category:Графика
Преобразование количества секунд в формат TTIME

=== Преобразование количества секунд в формат TTIME ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование количества секунд в формат TTIME (ЧЧ:ММ:СС).
Преобразование количества секунд в формат TTIME (ЧЧ:ММ:СС).
На выходе функции, получаем TTIME
Зависимости: system, sysutils
Автор: VID, vidsnap@mail.ru, ICQ:132234868, Махачкала
Copyright: VID
Дата: 14 июня 2002 г.
***************************************************** }
function SecToTime(Sec: Integer): TTime;
var
 H, M, S: INTEGER;
 HS, MS, SS: string;
begin
 S := Sec;
 M := Round(INT(S / 60));
 S := S - M * 60; //Seconds
 H := Round(INT(M / 60)); //Hours
 M := M - H * 60; //Minutes
 if H < 10 then
 HS := '0' + Inttostr(H)
 else
 HS := inttostr(H);
 if M < 10 then
 MS := '0' + Inttostr(M)
 else
 MS := inttostr(M);
 if S < 10 then
 SS := '0' + inttostr(S)
 else
 SS := inttostr(S);
 RESULT := StrToTime(HS + ':' + MS + ':' + SS);
end;
Пример использования: 
ShowMessage(TimeToStr(SecToTime(50)));
//получаем сообщение:
"00:00:50 "
Source: http://delphibase.endimus.com
Преобразование координат в параметрах событий OnDragOver и OnDragDrop, в координаты формы.

=== Преобразование координат в параметрах событий OnDragOver и OnDragDrop, в координаты формы. ===
Поверьте, достаточно просто преобразовать X,Y координаты, передаваемые в параметрах событий OnDragOver и OnDragDrop, в координаты формы. 
Работайте со свойствами Left и Top компонента, над которым перемещается курсор. Приведу простой пример. Поместите на форму компонент Memo и присвойте свойству Align значение alTop. Поместите на форму панель, также присвойте свойству Align значение alTop и задайте небольшое значение свойству Height, скажем 6 или 7 пикселей. Установите DragMode на dmAutomatica и DragCursor на crVSplit. Поместите другой Memo-компонент и установите Align на alClient. Одновременно выберите оба Memo-компонента, панель и создайте общий обработчик события OnDragOver как показано ниже:
procedure TForm1.Memo1DragOver(Sender, Source: TObject; X, Y: Integer;
 State: TDragState; var Accept: Boolean);
begin
 if Source = Panel1 then
 with Sender as TControl do
 begin
 Accept := True;
 Memo1.Height := Y + Top;
 end
 else
 Accept := False;
end;
Source: http://delphiworld.narod.ru/
ID: 00728
Category:VCL
Category:DragAndDrop
Преобразование строки в число

=== Преобразование строки в число ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование строки в число
Преобразует строку в число, при этом удаляя из строки все лишние символы
Зависимости: нет
Copyright: Separator
Дата: 7 мая 2003 г.
***************************************************** }
function StringToNumber(const Value: string): string;
var
 ResStr: string;
 i, j, L: integer;
 Ch: char;
 E, DS: boolean;
begin
 Result := '0';
 L := Length(Value);
 if L <> 0 then
 begin
 SetLength(ResStr, L);
 E := false;
 DS := false;
 j := 0;
 for i := 1 to L do
 begin
 Ch := Value[i];
 case Ch of
 '0'..'9':
 begin
 Inc(j);
 ResStr[j] := Ch
 end; //'0'..'9': begin
 '.', ',': if (not DS) and (not E) and (i <> L) then
 begin
 DS := true;
 Ch := DecimalSeparator;
 if j = 0 then
 begin
 Inc(j);
 ResStr[j] := '0';
 end; //if j = 0 then begin
 Inc(j);
 ResStr[j] := Ch
 end; //'.', ',': if (not DS) and (i <> L) then begin
 'e', 'E': if (not E) and (i <> L) then
 begin
 E := true;
 Ch := 'E';
 if j = 0 then
 begin
 Inc(j);
 ResStr[j] := '0';
 end; //if j = 0 then begin
 Inc(j);
 ResStr[j] := Ch
 end; //'.', ',': if (not DS) and (i <> L) then begin
 end; //case Ch of
 end; //for i:= 1 to L do begin
 if j <> 0 then
 begin
 if ResStr[j] = 'E' then
 Dec(j);
 if ResStr[j] = DecimalSeparator then
 Dec(j);
 SetLength(ResStr, j);
 Result := ResStr
 end; //if j <> 0 then begin
 end; //if L <> 0 then begin
end;
Пример использования: 
Edit1.Text := ',...,fgftgtr656,.567erdf..5,,632';
Edit2.Text := StringToNumber(Edit1.Text);
// Edit2.Text = 0, 656567E5632
Author: Separator
Source: http://delphibase.endimus.com
ID: 00919
----
type 
 TCharSet = set of Char; 
function StripNonConforming(const S: string; 
 const ValidChars: TCharSet): string; 
var 
 DestI: Integer; 
 SourceI: Integer; 
begin 
 SetLength(Result, Length(S)); 
 DestI := 0; 
 for SourceI := 1 to Length(S) do 
 if S[SourceI] in ValidChars then 
 begin 
 Inc(DestI); 
 Result[DestI] := S[SourceI] 
 end; 
 SetLength(Result, DestI) 
end; 
function StripNonNumeric(const S: string): string; 
begin 
 Result := StripNonConforming(S, ['0'..'9']) 
end;
Source: http://delphiworld.narod.ru/
ID: 00922
Преобразование цвета RGB из-в HLS

{ Максимальные значения }
const
 HLSMAX = 240;
 RGBMAX = 255;
 UNDEFINED = (HLSMAX * 2) div 3;
var
 H, L, S: Integer; { H-оттенок, L-яркость, S-насыщенность }
 R, G, B: Integer; { цвета }
procedure RGBtoHLS;
var
 cMax, cMin: Integer;
 Rdelta, Gdelta, Bdelta: Single;
begin
 cMax := Max(Max(R, G), B);
 cMin := Min(Min(R, G), B);
 L := Round((((cMax + cMin) * HLSMAX) + RGBMAX) / (2 * RGBMAX));
 if (cMax = cMin) then
 begin
 S := 0;
 H := UNDEFINED;
 end
 else
 begin
 if (L <= (HLSMAX/2)) then
 S := Round((((cMax - cMin) * HLSMAX) + ((cMax + cMin) / 2)) / (cMax + cMin))
 else
 S := Round((((cMax - cMin) * HLSMAX) + ((2 * RGBMAX - cMax - cMin) / 2)) / (2 * RGBMAX - cMax - cMin));
 Rdelta := (((cMax - R) * (HLSMAX / 6)) + ((cMax - cMin) / 2)) / (cMax - cMin);
 Gdelta := (((cMax - G) * (HLSMAX / 6)) + ((cMax - cMin) / 2)) / (cMax - cMin);
 Bdelta := (((cMax - B) * (HLSMAX / 6)) + ((cMax - cMin) / 2)) / (cMax - cMin);
 if (R = cMax) then
 H := Round(Bdelta - Gdelta)
 else if (G = cMax) then
 H := Round((HLSMAX / 3) + Rdelta - Bdelta)
 else
 H := Round(((2 * HLSMAX) / 3) + Gdelta - Rdelta);
 if (H < 0) then
 H := H + HLSMAX;
 if (H > HLSMAX) then
 H := H - HLSMAX;
 end;
 if S < 0 then S := 0;
 if S > HLSMAX then S := HLSMAX;
 if L < 0 then L := 0;
 if L > HLSMAX then L := HLSMAX;
end;
procedure HLStoRGB;
var
 Magic1, Magic2: Single;
 function HueToRGB(n1, n2, hue: Single): Single;
 begin
 if (hue < 0) then hue := hue + HLSMAX;
 if (hue > HLSMAX) then hue := hue -HLSMAX;
 if (hue < (HLSMAX / 6)) then
 Result := (n1 + (((n2 - n1) * hue + (HLSMAX / 12)) / (HLSMAX / 6)))
 else if (hue < (HLSMAX / 2)) then
 Result := n2
 else if (hue < ((HLSMAX * 2) / 3)) then
 Result := (n1 + (((n2 - n1) * (((HLSMAX * 2) / 3) - hue) + (HLSMAX / 12)) / (HLSMAX / 6)))
 else
 Result := (n1);
 end;
begin
 if (S = 0) then
 begin
 B := Round((L * RGBMAX) / HLSMAX);
 R := B;
 G := B;
 end
 else
 begin
 if (L <= (HLSMAX / 2)) then
 Magic2 := (L * (HLSMAX + S) + (HLSMAX / 2)) / HLSMAX
 else
 Magic2 := L + S - ((L * S) + (HLSMAX / 2)) / HLSMAX;
 Magic1 := 2 * L - Magic2;
 R := Round((HueToRGB(Magic1, Magic2, H + (HLSMAX / 3)) * RGBMAX + (HLSMAX / 2)) / HLSMAX );
 G := Round((HueToRGB(Magic1, Magic2, H) * RGBMAX + (HLSMAX / 2)) / HLSMAX );
 B := Round((HueToRGB(Magic1, Magic2, H - (HLSMAX / 3)) * RGBMAX + (HLSMAX / 2)) / HLSMAX );
 end;
 if R < 0 then R := 0;
 if R > RGBMAX then R := RGBMAX;
 if G < 0 then G := 0;
 if G > RGBMAX then G := RGBMAX;
 if B < 0 then B := 0;
 if B > RGBMAX then B := RGBMAX;
end;
Author: Зайцев О.В.
Author: Владимиров А.М.
Source: http://forum.sources.ru
ID: 03671
Category:Графика
Category:Цвета и палитры