Мастера DELPHI, Delphi programming community Рейтинг@Mail.ru Титульная страница Поиск, карта сайта Написать письмо 
| Новости |
Новости сайта
Поиск |
Поиск по лучшим сайтам о Delphi
FAQ |
Огромная база часто задаваемых вопросов и, конечно же, ответы к ним ;)
Статьи |
Подборка статей на самые разные темы. Все о DELPHI
Книги |
Новинки книжного рынка
Новости VCL
Обзор свежих компонент со всего мира, по-русски!
|
| Форумы
Здесь вы можете задать свой вопрос и наверняка получите ответ
| ЧАТ |
Место для общения :)
Орешник
Коллекция курьезных вопросов из форумов
Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / rsdn.org

 
Чтобы не потерять эту дискуссию, сделайте закладку « предыдущая ветвь | форум | следующая ветвь »

Basic format that also works for freepascal


Thaddy ©   (19.08.14 14:57

Here's a simple version that also works for freepascal (ansi and unicode) of the Format function. I missed that and it is also marked as missing in kol.pas.

function Format( const fmt: KOLString; params: array of const): KOLString;
var
   ElsArray, El: PPtrUInt;
   I : Integer;
   P : PPtrUInt;
begin
 Setlength(Result,1024);
 ElsArray := nil;
 if High( params ) >= 0 then
   GetMem( ElsArray, (High( params ) + 1) * sizeof( Pointer ) );
 El := ElsArray;
 for I := 0 to High( params ) do
 begin
   P := @params[ I ];
   P := Pointer( P^ );
   El^ := PtrUInt( P );
   Inc( El );
 end;
 wvsprintf( PKOLChar(Result), PKOLChar( fmt ), Pointer( ElsArray ) );
 if ElsArray <> nil then
    FreeMem( ElsArray );
end;


Thaddy ©   (19.08.14 15:05[1]

Oops, that is the worng one. Clipboard playing tricks on me ;) This is the correct one, sorry:

// format function that also works in freepascal. Ansi and Unicode
// only handles string types and integer types
function Format(Format: KolString; const Args: array of const): KolString;
type
 TVAList = array[0..$FFFF] of Pointer;
var
 VA: TVAList;
 StrI, I, Size: Integer;
 Strings: array[0..High(VA)] of KolString;
begin
 Result :='';
 If length(Args) > 0 then
 begin
   StrI := 0;
   Size := Length(Format) *SizeOf(KolChar);
   SetLength(Result,1024);
   for I := 0 to Length(Args) - 1 do
     with Args[I] do
         case VType of
         vtInteger:
           begin
             VA[I] := Pointer(VInteger);
             Inc(Size, SizeOf(TVarRec));
           end;
         vtPChar,
         vtAnsiString:
           begin
             Strings[StrI] := VPChar + #0;
             VA[I] := @Strings[StrI][1];
             Inc(Size, Length(Strings[StrI]) * 2 - 2 {null-terminator});
             Inc(StrI);
           end;
         vtPWideChar,
         vtWideString:
           begin
             VA[I] := VPWideChar;
             Inc(Size, Length(VPWideChar) * 2);
           end;
          else
            // eat unknowns silently
             Result :='';
         end;
   end;
 if length(Result) > 0 then
    SetLength(Result, wvsprintf(@Result[1], PKolChar(Format), @VA));
end;


Thaddy ©   (19.08.14 15:15[2]

I left in some debug code.
This one is much cleaner and easier to adapt:

// format function that also works for Freepascal.
// limited, but easy to extend.
function Format(Format: KolString; const Args: array of const): KolString;
type
 TVAList = array[0..$FFFF] of Pointer;
var
 VA: TVAList;
 StrI, I: Integer;
 Strings: array[0..High(VA)] of KolString;
begin
 Result :='';
 If length(Args) > 0 then
 begin
   StrI := 0;
   SetLength(Result,1024);
   for I := 0 to Length(Args) - 1 do
     with Args[I] do
       case VType of
         vtInteger: VA[I] := Pointer(VInteger);
         vtPChar,
         vtAnsiString:
           begin
             Strings[StrI] := VPChar + #0;
             VA[I] := @Strings[StrI][1];
             Inc(StrI);
           end;
         vtPWideChar,
         vtWideString:VA[I] := VPWideChar;
          else
            // eat unknowns silently
             Result :='';
       end;
   end;
 if length(Result) > 0 then
    SetLength(Result, wvsprintf(PKolChar(Result), PKolChar(Format), @VA));
end;


Thaddy ©   (19.08.14 15:20[3]

BTW it also works for the KOL 64 bit version! Both in XE2 and in Freepascal 2.7.1.


thaddy ©   (20.08.14 10:03[4]

Again some improvement.
Tested for FPC 2.7.1 and Delphi 4-XE2 both 32 and 64 bit.
Maybe Vladimir can insert it in kol.pas?
Because it is important for freepascal.

Seems that this is enough, but you need at least delphi 4:


// only handles string types and integer types
function Format2(Format: KolString; const Args: array of const): KolString;
type
 TVAList = array[0..$FFFF] of Pointer;
var
 VA: TVAList;
 I: Integer;
begin
 Result :='';
 If length(Args) > 0 then
 begin
   SetLength(Result,1024); // this is documented maximum
   for I := 0 to Length(Args) - 1 do
     with Args[I] do
         case VType of
         vtInteger:VA[I] := Pointer(VInteger);
         vtPChar,
         vtAnsiString:VA[I] := VPChar;
         vtPWideChar,
         vtWideString:VA[I] := VPWideChar;
          else
            // eat unknowns silently
             Result :='';
         end;
   end;
 if length(Result) > 0 then
    SetLength(Result, wvsprintf(PKolChar(Result), PKolChar(Format), @VA));
end;


thaddy ©   (20.08.14 10:09[5]

ignore the last. It breaks. The previous one is good.


thaddy ©   (20.08.14 10:48[6]

It still fails some tests, so ignore it. I will open a new post when finished.
Probably just Ansi version only.


имя   (20.10.15 16:59[7]

Удалено модератором


имя   (20.10.15 18:37[8]

Удалено модератором


версия для печати

Написать ответ

Ваше имя (регистрация  E-mail 







Разрешается использование тегов форматирования текста:
<b>жирный</b> <i>наклонный</i> <u>подчеркнутый</u>,
а для выделения текста программ, используйте <code> ... </code>
и не забывайте закрывать теги! </b></i></u></code> :)


Наверх

  Рейтинг@Mail.ru     Титульная страница Поиск, карта сайта Написать письмо