nyuuzyou/wikis huggingface dataset:
String → PWideChar

=== String --> PWideChar ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Конвертация String в PWideChar
Зависимости: ???
Copyright: Andre .v.d. Merwe
Дата: 18 июля 2002 г.
********************************************** }
function StringToPWide(sStr: string; var iNewSize: integer): PWideChar;
var
 pw: PWideChar;
 iSize: integer;
begin
 iSize := Length(sStr) + 1;
 iNewSize := iSize * 2;
 pw := AllocMem(iNewSize);
 MultiByteToWideChar(CP_ACP, 0, PChar(sStr), iSize, pw, iNewSize );
 Result := pw;
end; 
Пример использования:
procedure TForm1.Button1Click(Sender: TObject);
var
 iSize: integer;
begin
 ChangeWallpaper(StringToPWide('C:\1.jpg', iSize));
end; 
Author: Andre .v.d. Merwe
Source: http://kladovka.net.ru
ID: 00176
String → StringList

=== String --> StringList ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Преобразование строки с разделителями в StringList.
Преобразование строки с разделителями в StringList или наследник TStrings.
Навеяно одноименной процедурой из InfoPower :-)
Зависимости: Classes
Copyright: Игорь Шевченко, Woll2Woll software (original)
Дата: 30 апреля 2002 г.
***************************************************** }
procedure StrBreakApart(const S, Delimeter: string; Parts: TStrings);
var
 CurPos: integer;
 CurStr: string;
begin
 Parts.Clear;
 Parts.BeginUpdate();
 try
 CurStr := S;
 repeat
 CurPos := Pos(Delimeter, CurStr);
 if (CurPos > 0) then
 begin
 Parts.Add(Copy(CurStr, 1, Pred(CurPos)));
 CurStr := Copy(CurStr, CurPos + Length(Delimeter),
 Length(CurStr) - CurPos - Length(Delimeter) + 1);
 end
 else
 Parts.Add(CurStr);
 until CurPos = 0;
 finally
 Parts.EndUpdate();
 end;
end;
Пример использования: 
var
 Tmp: StringList;
begin
 Tmp := TStringList.Create();
 StrBreakApart('Text1<BR>Text2<BR>Text3<BR>Text4', '<BR>', Tmp);
 // После вызова Tmp содержит
 // Text1
 // Text2
 // Text3
 // Text4
 // ...
 Tmp.Free();
end;
Author: Игорь Шевченко, Woll2Woll software (original)
Source: delphibase.endimus.com
ID: 00920
----
Можно сделать значительно проще:
procedure StrBreakApart(const S, Delimeter: string; Parts: TStrings);
begin
 Parts.Text := StringReplace(S, Delimeter, #13#10, [rfReplaceAll, rfIgnoreCase]);
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 00921
String → WideString

=== String --> WideString ===
{: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: 00159
TCanvas и освобождение дескрипторов

TCanvas автоматически ReleaseDC не вызывает. При создании холста с WindowDC в качестве дескриптора, лучшей идеей будет создание потомка TCanvas (моделированного с TControlCanvas):
type
 TWindowCanvas = class(TCanvas)
 private
 FWinControl: TWinControl;
 FDeviceContext: HDC;
 procedure SetWinControl(AControl: TWinControl);
 protected
 procedure CreateHandle; override;
 public
 destructor Destroy; override;
 procedure FreeHandle;
 property WinControl: TWinControl read FWinControl write SetWinControl;
 end;
implementation
destructor TWindowCanvas.Destroy;
begin
 FreeHandle;
 inherited Destroy;
end;
procedure TWindowCanvas.CreateHandle;
begin
 if FControl = nil then
 inherited CreateHandle
 else
 begin
 if FDeviceContext = 0 then
 FDeviceContext := GetWindowDC(WinControl.Handle);
 Handle := FDeviceContext;
 end;
end;
procedure TControlCanvas.FreeHandle;
begin
 if FDeviceContext <> 0 then
 begin
 Handle := 0;
 ReleaseDC(WinControl.Handle, FDeviceContext);
 FDeviceContext := 0;
 end;
end;
procedure TControlCanvas.SetWinControl(AControl: TWinControl);
begin
 if FWinControl <> AControl then
 begin
 FreeHandle;
 FWinControl := AControl;
 end;
end;
Очевидно, вы должны должны следить за ситуацией, и разрушать TWindowCanvas (или освобождать дескриптор) перед тем, как уничтожить элемент управления, связанный с ним. Также, имейте в виду, что дескриптор DeviceContext не освобождается автоматически после обработки каждого сообщения (как это происходит с дескрипторами TControlCanvas); для освобождения дескриптора вы должны явно вызвать FreeHandle (или разрушить Canvas). И, наконец, имейте в виду, что "WindowCanvas.Handle:= 0" не освобождает дескриптор, для его освобождения вы должны вызывать FreeHandle.
Source: http://delphiworld.narod.ru
ID: 03724
Category:Графика
TCheckListBox: использование методов LoadFromFile/SaveToFile

=== TCheckListBox: использование методов LoadFromFile/SaveToFile ===
Пример показывает как можно сохранять в файл содержимое TCheckListBox и соответственно восстанавливать из файла ранее сохранённые состояния Чекбоксов.
На самом деле всё просто. Метод SaveToFile просто напросто сохраняет в обычном текстовом виде значения чекбоксов. Но предварительно нам нужно преобразовать состояния чекбоксов в текстовый вид, соответственно "1" или "0".
Далее задача метода LoadFromFile считать эти значения и преобразовать сначало в числовой вид, а затем в логический (true или false). 
procedure TFrameRuleEngine.SaveRules; 
var 
 i: Integer; 
begin 
 i := 0; 
 while i < CheckListBoxRule.Items.Count do 
 begin 
 if CheckListBoxRule.Items[i] = then 
 begin 
 // Если ячейка пустая, то удаляем её 
 CheckListBoxRule.Items.Delete(i); 
 end 
 else 
 begin 
 // Добавляем 1 или 0 соответственно checked или not checked 
 CheckListBoxRule.Items[i] := IntToStr(Integer(CheckListBoxRule.Checked[i])) + CheckListBoxRule.Items[i]; 
 Inc(i); 
 end; 
 end; 
 // Сохраняем весь список 
 CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); 
end; 
procedure TFrameRuleEngine.LoadRules; 
var 
 sChecked: String; 
 i: Integer; 
begin 
 if FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') then 
 begin 
 // Считываем файл 
 CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) + 'Rule.Txt'); 
 i := 0; 
 while i < CheckListBoxRule.Items.Count do 
 begin 
 if CheckListBoxRule.Items[i] = then 
 begin 
 // Удаляем пустую ячейку 
 CheckListBoxRule.Items.Delete(i); 
 end 
 else 
 begin 
 // получаем состояние чекбокса 
 sChecked := Copy(CheckListBoxRule.Items[i], 1, 1); 
 CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2, Length(CheckListBoxRule.Items[i])); 
 // Обновляем свойство Checked 
 CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked)); 
 Inc(i); 
 end; 
 end; 
 end; 
end; 
 Bjarne \v/ 
 http://www.go2NTS.com 
Source: Взято из http://forum.sources.ru
ID: 00645
TClientDataSet. Некорректное формирование XML

=== TClientDataSet. Некорректное формирование XML ===
Delphi5 build 5.62, midas.dll v5.0.5.63
При использовании SaveToFile('file.xml', dfXML) формируется некорректный текст XML, если набор данных содержит изменения, т.е. при непустом Delta.
Пример:
Набор данных состоит их двух полей
IntField: integer
StrField: string(20)
После ввода
 1 aaa
 2 bbb
 3 ccc
 4 ddd
и сохранения текст XML имеет вид:
<?xml version="1.0" standalone="yes"?> <DATAPACKET Version="2.0">
<METADATA><FIELDS><FIELD attrname="IntField" fieldtype="i4"/>
<FIELD attrname="StrField" fieldtype="string" WIDTH="20"/></FIELDS>
<PARAMS CHANGE_LOG="1 0 4 2 0 4 3 0 4 4 0 4"/></PARAMS></METADATA>
<ROWDATA><ROW RowState="4" IntField="1" StrField="aaa"/>
<ROW RowState="4" IntField="2" StrField="bbb"/>
<ROW RowState="4" IntField="3" StrField="ccc"/>
<ROW RowState="4" IntField="4" StrField="ddd"/>
</ROWDATA></DATAPACKET>
Ошибочным является наличие тэга </PARAMS>, т.к. открывающий тэг <PARAMS.../> уже содержит ограничитель "/"
После вызова MergeChangeLog, CancelUpdates или ApplyUpdates сохраняется корректный XML.
; КОММЕНТАРИЙ: Проблема заключена именно в midas.dll. При проверке в Delphi 5 update pack 1 (build 6.18) баг не проявляется - XML формируется корректно. Если же сменить midas.dll на старую - версии 5.0.5.63 - получаем вышеописанный результат.
Скачать тест StoneTest_22.zip (2.3K)
Мораль сей басни такова: ставьте свежие сервиспаки.
Source: Взято с http://delphiworld.narod.ru
ID: 03106
Category:Базы данных
Category:XML
TClientDataSet. Утечка памяти при загрузке XML

=== TClientDataSet. Утечка памяти при загрузке XML ===
Hапpимеp, если делаем:
ClientDataSet.LoadFromFile('c:\tmp\1.xml');
ClientDataSet.Close;
то видим, что память выделилась, но не освободилась.
Если даже делать ClientDataSet.Create и ClientDataSet.Free то все равно будут утечки.
Пробовал также пеpед закрытием:
ClientDataSet.EmptyDataSet;
ClientDataSet.CancelUpdates;
ClientDataSet.LogChanges := False;
ClientDataSet.MergeChangeLog;
ClientDataSet.FieldDefs.Clear;
ClientDataSet.IndexDefs.Clear;
ClientDataSet.Params.Clear;
ClientDataSet.Aggregates.Clear;
ClientDataSet.IndexName := ;
ClientDataSet.IndexFieldNames := ;
Все равно не помогает.
Решения не нашел. Тестировал под D5 под W2000, W98. Также брал midas.dll от D6. Проблема осталась.
КОММЕНТАРИЙ
Действительно, проверка показывает, что при загрузке данных из XML-файла последующее закрытие ClientDataSet не освобождает часть выделенной памяти. Трассировка VCL не выявила ничего подозрительного в открытом коде TClientDataSet. Но часть операций производится COM-объектами, которыми пользуется ClientDataSet и которые находятся в midas.dll.
Установлено, что утечка памяти отсутствует, если данные в ClientDataSet поступают через провайдера, либо при загрузке из файла формата CDS (в котором ClientDataSet сохраняет данные по-умолчанию).
Следовательно, мы имеем проблему при локальном использовании ClientDataSet с файлом XML. Вероятно, в midas.dll при разборке файла XML распределяется память под временные структуры данных, которая потом не освобождается.
Source: Взято с http://delphiworld.narod.ru
ID: 03107
Category:Базы данных
Category:XML
TColor в HTML Color

Функция для преобразования цвета TColor в формат цветов HTML
uses SysUtils, Graphics;
function TColorToHTML(const Value: TColor): string;
var
 RGBColor: Longint;
begin
 RGBColor := ColorToRGB(Value);
 Result := Format('#%.2x%.2x%.2x', [GetRValue(RGBColor), GetGValue(RGBColor), GetBValue(RGBColor)]);
end;
Author: Smike
Source: http://forum.sources.ru
ID: 03677
Category:Графика
Category:Цвета и палитры
TComboBox.ReadOnly

=== TComboBox.ReadOnly ===
Иногда хочется сделать так, чтобы в комбобоксе, пользователь мог только выбирать из списка но не вводить текст с клавиатуры.
Так можно включить "ComboBox.ReadOnly"
 SendMessage(GetWindow(ComboBox1.Handle,GW_CHILD), EM_SETREADONLY, 1, 0);
а так выключить.
 SendMessage(GetWindow(ComboBox1.Handle,GW_CHILD), EM_SETREADONLY, 0, 0); 
При csDropDownList нельзя набирать для выбора, то есть если нажал "К" а потом "О", то вначале выберется слово на "К" а потом на "О", а так выберется слово на "КО", и текст нельзя из него копировать. 
Author: Fantasist
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00668
TCustomControl

=== TCustomControl ===
Класс TCustomControl предназначен для создания на его основе нестандартных оконных элементов управления. Процесс визуализации в нем упрощен за счет использования специального класса TCanvas, инкапсулирующего канву (см. гл. 11). 
Доступ к канве осуществляется через свойство 
 property Canvas: TCanvas; 
Отрисовка элемента управления осуществляется методом 
 procedure PaintWindowfDC: HDC); override; 
после получения сообщения WM_PAINT. 
Возможности этого класса унаследовали классы TPanel, TGroupBox, TStringGrid и т. д. 
ID: 00326
TDateTimePicker → StringGrid

=== TDateTimePicker в StringGrid ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Grids, ComCtrls;
type
 TForm1 = class(TForm)
 StringGrid1: TStringGrid;
 DateTimePicker1: TDateTimePicker;
 procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
 var CanSelect: Boolean);
 procedure FormCreate(Sender: TObject);
 procedure StringGrid1Exit(Sender: TObject);
 procedure DateTimePicker1Exit(Sender: TObject);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
 ARow: Integer; var CanSelect: Boolean);
var
 D: TDateTime;
begin
 DateTimePicker1.Visible := True;
 DateTimePicker1.BoundsRect := StringGrid1.CellRect(ACol, ARow);
 D := DateTimePicker1.DateTime;
 TryStrToDateTime(StringGrid1.Cells[ACol, ARow], D);
 DateTimePicker1.DateTime := D;
 DateTimePicker1.SetFocus;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 DateTimePicker1.Parent := StringGrid1;
 DateTimePicker1.Visible := False;
 DateTimePicker1.OnExit := DateTimePicker1Exit;
 StringGrid1.OnSelectCell := StringGrid1SelectCell;
end;
procedure TForm1.StringGrid1Exit(Sender: TObject);
begin
 DateTimePicker1.Visible := False;
end;
procedure TForm1.DateTimePicker1Exit(Sender: TObject);
begin
 with StringGrid1 do
 Cells[Col, Row] := DateTimeToStr(DateTimePicker1.DateTime);
end;
end.
Author: Smike
Source: Взято из http://forum.sources.ru
ID: 00389
TFileTime в TDateTime

=== TFileTime в TDateTime ===
function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
 ModifiedTime: TFileTime;
 SystemTime: TSystemTime;
begin
 Result := 0;
 if (FileTime.dwLowDateTime = 0) and (FileTime.dwHighDateTime = 0) then
 Exit;
 try
 FileTimeToLocalFileTime(FileTime, ModifiedTime);
 FileTimeToSystemTime(ModifiedTime, SystemTime);
 Result := SystemTimeToDateTime(SystemTime);
 except
 Result := Now; // Something to return in case of error
 end;
end;
function DateTimeToFileTime(FileTime: TDateTime): TFileTime;
var
 LocalFileTime, Ft: TFileTime;
 SystemTime: TSystemTime;
begin
 Result.dwLowDateTime := 0;
 Result.dwHighDateTime := 0;
 DateTimeToSystemTime(FileTime, SystemTime);
 SystemTimeToFileTime(SystemTime, LocalFileTime);
 LocalFileTimeToFileTime(LocalFileTime, Ft);
 Result := Ft;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 03149
Category:Файловая система
TGraphicControl

=== TGraphicControl ===
Класс TGraphicControl предназначен для создания на его основе визуальных компонентов, не получающих фокус в процессе выполнения приложения. Так как непосредственным предком класса является класс TControl, то потомки TGraphicControl умеют реагировать на управляющие воздействия мышью. 
Наглядный пример элемента управления, которому не нужно получать фокус, - это компонент TLabel, предназначенный для отображения текста, или компонент TImage, предназначенный для визуализации изображений. 
Для визуализации элементов управления на основе этого класса используется канва, инкапсулированная в классе TCanvas. 
Доступ к канве осуществляется через свойство 
 property Canvas: TCanvas; 
Отрисовка элемента управления осуществляется методом 
 procedure PaintWindow(DC: HDC); override; 
после получения сообщения WM_PAINT. 
ID: 00327
TIF в PDF

Совместимость: Delphi 5.x (или выше)
Как-то раз получился TIF файл на несколько страниц и возникла необходимость конвертации его в PDF формат. Для использования такой возможности необходимо иметь полную версию Adobe Acrobat. Функция тестировалась на Adobe Acrobat 4.0.
Сперва Вам необходимо импортировать элементы управления Acrobat AxtiveX.
:1) Выберите Component -> Import ActiveX Control
:2) Выберите Acrobat Control for ActiveX и нажмите install
:3) Выберите пакет ActiveX control для инсталляции
:4) Добавьте PDFlib_tlb в Ваш проект. Этот файл находится в директории Borland\Delphi5\Imports.
== Как использовать функцию ==
Вот пример её вызова:
 if not TifToPDF('c:\test.tif', 'c:\test.pdf') then Showmessage('Could not convert');
== Функция TifToPdf ==
function TifToPDF(TIFFilename, PDFFilename: string): Boolean;
var
 AcroApp: Variant;
 AVDoc: Variant;
 PDDoc: Variant;
 IsSuccess: Boolean;
begin
 Result := False;
 if not FileExists(TIFFilename) then Exit;
 try
 AcroApp := CreateOleObject('AcroExch.App');
 AVDoc := CreateOleObject('AcroExch.AVDoc');
 AVDoc.Open(TIFFilename, );
 AVDoc := AcroApp.GetActiveDoc;
 if AVDoc.IsValid then
 begin
 PDDoc := AVDoc.GetPDDoc;
 PDDoc.SetInfo ('Title', );
 PDDoc.SetInfo ('Author', );
 PDDoc.SetInfo ('Subject', );
 PDDoc.SetInfo ('Keywords', );
 Result := PDDoc.Save(1 or 4 or 32, PDFFilename);
 PDDoc.Close;
 end;
 AVDoc.Close(True);
 AcroApp.Exit;
 finally
 VarClear(PDDoc);
 VarClear(AVDoc);
 VarClear(AcroApp);
 end;
end;
Author: Morten Ravn-Jonsen
Source: http://forum.sources.ru
ID: 04280
Category:Конвертация
TImageList. Не отображаются иконки на контролах

=== TImageList. Не отображаются иконки на контролах ===
Не отображаются картинки на тулбарах, кнопках, меню, и т.д. - везде, где используется TImageList для хранения массива изображений. Искажение цветов при использовании 256-цветных картинок в палитровом видеорежиме. 
ТИПОВЫЕ РЕШЕНИЯ.
* Не использовать TImageList, если это возможно. 
* Не хранить содержимое TImageList в ресурсе формы, а загружать в runtime из подготовленной bitmap или ресурса. 
* Обновить версию системной библиотеки comctl32.dll. 
Source: http://delphiworld.narod.ru/
ID: 01260
TListView в режиме отчета под манифестом XP

=== TListView в режиме отчета под манифестом XP ===
{ 
 The TListView with a vsReport style causes an access violation 
 when you run your project with a XP manifest resource. 
 The VCL wrapper has a bug and you must patch sources. 
 Just copy the comctrls.pas unit in the folder with your own 
 project and modify the UpdateColumn method. 
 After compiling the project, a comctrls.dcu is created 
 and you can replace the original comctrls.dcu with the 
 patched one. 
}
 { 
 Wenn ein XP Manifest als Ressource in eine Exe-Datei eingebunden 
 wird, um einer Applikation das neue XP-Design zu verleihen, 
 gibt es bei der TListView mit Style vsReport eine Zugriffsverletzung 
 und die Anwenung lasst sich nicht starten. 
 Das ist ein VCL Bug und kann behebt werden, indem 
 comctrls.pas modifiziert wird. 
 Kopiere die comctrls.pas in dein Projekte-Verzeichnis und 
 andere die UpdateColumn Methode wie folgt. 
 Nach dem Kompilieren wird eine Comctrls.dcu Datei erstellt. 
 Die original Comctrls.dcu kann nun durch die modifizierte ersetzt werden. 
}
// ComCtrls.pas: 
procedure TCustomListView.UpdateColumn(AnIndex: Integer);
 {...}
 with Column, Columns.Items[AnIndex] do
 begin
 { PATCH start:}
 // mask := LVCF_TEXT or LVCF_FMT or LVCF_IMAGE; 
 mask := LVCF_TEXT or LVCF_FMT;
 if FImageIndex >= 0 then
 mask := mask or LVCF_IMAGE;
 { PATCH :end }
 {...}
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01146
TMemo → DBGrid

=== Мемо в DBGrid ===
{
A common problem when working with DBGrid is, that this component can't display TMemo fields,
multiline columns, Graphics...
There are a few good freeware components around to solve this problem.
The best one is definitly "DBGRIDPLUS", which comes with full sources.
However, this component does not allow to edit the text in memo fields.
The delphi fans out there who bought a delphi version that comes with the VCL sources can
fix this problem:
Open dbgrids.pas and make the following changes:
(To have memo editing in your app you must just add the modifyed version of dbgrids.pas to your uses clause)
}
function TCustomDBGrid.GetEditLimit: Integer;
begin
 Result := 0;
 if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString, ftMemo]) then <-- Add
 Result := SelectedField.Size;
end;
function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
 Result := ;
 if FDatalink.Active then
 with Columns[RawToDataColumn(ACol)] do
 if Assigned(Field) then
 Result := Field.AsString; <-- Change this.
 FEditText := Result;
end;
{
Just compare theese edited functions with the original ones, and you will know what to change.
To get multiline cell support (not in memo fields!) for DBGridPlus, send me an email and i can send you the changed DBGridPlus.pas file.
}
Language: en
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00387
TMemoryStream → Array of Byte

=== TMemoryStream --> Array of Byte ===
Для преобразования TMemoryStream в array of Byte можно использовать следующий код:
procedure TForm1.Button1Click(Sender: TObject);
var
 M: TMemoryStream;
 Buff: array of Byte;
begin
 M := TMemoryStream.Create;
 try
 M.LoadFromFile('c:\test.htm');
 SetLength(Buff, M.Size);
 M.Position := 0;
 if M.Size > 0 then
 M.Read(Buff[0], M.Size);
 finally
 M.Free;
 end;
end;
Author: Rouse_
ID: 00251
TMetaFile - ошибка при работе с памятью

Для создания в памяти метафайла, я пытаюсь использовать TMetafile. Чтобы я ни делал, это не работает как надо. Я получаю метафайл или неверного размера, или без возможности масштабирования.
Я долго экспериментировал и пришел к выводу, что все эти ошибки возникают в случае, когда map mode (режим карты) использует не mm_Text. Я трассировал ошибку в TMetafile.SaveToClipboardFormat. Программа неверно использует значение по умолчанию TMetafileImage.FInch = 0. Я думаю что TMetafileImage должен иметь значение по умолчанию FInch = Screen.PixelsPerInch или программа, которая сохраняет его в буфере обмена, должна правильно использовать FInch = 0 (т.е. сделайте значение mm_Text).
Source: http://delphiworld.narod.ru/
ID: 03815
Category:Графика
TPaintBox в буфер обмена

=== TPaintBox в буфер обмена ===
var
 pbRect: TRect;
begin
 pbRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
 BitMap := TBitMap.Create;
 try
 Bitmap.Width := PaintBox1.Width;
 Bitmap.Height := PaintBox1.Height;
 BitMap.Canvas.CopyRect(pbRect, PaintBox1.Canvas, pbRect);
 ClipBoard.Assign(BitMap);
 finally
 BitMap.Free;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01913
TStatusBar+TProgressBar

=== TStatusBar+TProgressBar ===
* Как поместить ProgressBar в панель StatusBar?
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 00518
----
var
 pb: TProgressBar;
begin
 pb:= TProgressBar.Create(self);
 with pb do
 begin
 Parent := StatusBar1;
 Position := 30;
 Top := 2;
 Left := 0;
 Height := StatusBar1.Height - Top;
 Width := StatusBar1.Panels[0].Width - Left;
 end;
 pb.Visible := True;
end; 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00519
----
unit adStatba;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls;
type
 TAdrockStatusBar = class(TStatusBar)
 public
 { Public declarations }
 constructor Create(Aowner : TComponent); override;
 end;
procedure Register;
implementation
constructor TAdrockStatusBar.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 ControlStyle := ControlStyle + [csAcceptsControls];
end;
procedure Register;
begin
 RegisterComponents('Adrock', [TAdrockStatusBar]);
end;
end. 
Это позволит вам разместить элемент управления в панели. Но этот способ не поддерживает использование вложенных панелей. Вероятно, вам также понадобиться выровнять элемент управления по правому краю. Не так это все сложно... 
Сборник Kuliba
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 00520
----
pgProgress положить на форму как Visible := false; StatusPanel надо OwnerDraw сделать и рефрешить, если Position меняется.
procedure TMainForm.stStatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
begin
 if Panel.Index = pnProgress then
 begin
 pgProgress.BoundsRect := Rect;
 pgProgress.PaintTo(stStatusBar.Canvas.Handle, Rect.Left, Rect.Top);
 end;
end; 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00521
----
 with TProgressBar.Create(StatusBar1) do Parent := StatusBar1; 
Author: Song
ID: 00522