Konkurs: printf w Pascalu

5

Zapraszam na taki mój mały konkurs-sam-nie-wiem-co ;)


Celem jest napisanie uproszczonego odpowiednika instrukcji `printf` znanej z C++; założenia: 1) należy umożliwić korzystanie z tej procedury następująco: `moje_printf(format, argument 1, argument 2, argument 3, ...)`. 1a) `format` to ciąg znaków (`string`) 1b) argument może być liczbą całkowitą, liczbą zmiennoprzecinkową lub ciągiem znaków (w tym tylko `PChar`); obsługa Unicode i/lub innych "nowoczesnych" rozwiązań nie jest wymagana. 1c) kod musi obsługiwać liczbę argumentów od zera do (przynajmniej) piętnastu; jakiegoś innego górnego limitu nie ma 2) procedura musi wypisywać na końcu znak nowej linii; innymi słowy: `moje_printf('foo');` ma być tym samym, co `writeln('foo');` 3) argumenty mają być przekazywane bezpośrednio po przecinku - podobnie, jak w przypadku `write`-pochodnych; znaczy to tyle, że `moje_printf(format, [args])` jest **błędne** - musi być `moje_printf(format, args)` 4) procedura **musi** obsługiwać następujące formaty/argumenty: `%int32`, `%pchar`, `%double` - ewentualne pochodne w stylu `%uint16` bądź `%extended` **nie są** obowiązkowe. 5) liczby zmiennoprzecinkowe mogą być wyświetlane na trzy sposoby (do wyboru do koloru): 5a) notacja naukowa 5b) w stylu `12.34000000` 5b) j/w, lecz obcinając nieznaczące ostatnie zera po przecinku (kropce) 6) kod może być napisany pod konkretny kompilator, architekturę oraz system; innymi słowy: niekoniecznie musi być przenośny. 7) musi być napisany w Pascalu lub którymś z jego dialektów 8) have fun! ;)
Przykładowy kod: ```delphi { tutaj deklaracja oraz definicja "moje_printf" }

Var A: int32 = 512;
B: PChar = 'Hello!';
C: Double = 123.456;
Begin
moje_printf('A = %int32 | B = %pchar | C = %double | 55 = %int32', A, B, C, int32(55));
End.

Powinien zwrócić:

A = 512 | B = Hello! | C = 123.456 | 55 = 55

<hr>
Czas trwania: od dzisiaj (tj.3 września 2013) przez cały tydzień, czyli do 10 września 2013.
Kody proszę publikować w tym wątku (z linkami do pastebin oraz ew.wyjaśnieniem zasady działania) :)
Jeżeli żaden kod się nie pojawi, upublicznię moją wersję (tym zdaniem stwierdzam również, że taki kod jest możliwy do napisania).
Z racji tego, że mimo wszystko nie jest to nic wybitnie trudnego do napisania, do wygrania jest satysfakcja z wygranej i respekt na całej dzielnicy :D
0

@Patryk27 - ciekawy pomysł, masz plusik ode mnie; Postaram się coś naskrobać jak znajdę dłuższą chwilę;

Niemniej jednak wstawiając tutaj kod przed czasem ułatwi się pracę innym, nawet tym, którzy na dzień dzisiejszy czegoś takiego nie potrafią napisać; IMHO lepiej było by zacząć kody wklejać w ostatnim dniu w ostatniej godzinie (albo dwóch) konkursu - przynajmniej kody wstawią Ci, którzy sami je napisali;

Jak wolicie - to tylko zabawa :]


EDIT: @Patryk27 - posiedziałem chwilkę i mam gotowe rozwiązanie; Napisz, czy zgadzasz się na przesłanie kodu na Twoje PM.

EDIT: No i kicha - wcale nie zrobiłem, źle zinterpretowałem punkt 1, 3 i przykładowy kod; Nie mam pojęcia jak zadeklarować procedurę z dowolnymi argumentami dowolnej ilości, coś w rodzaju array of const (ale nie na jej bazie) bez jakiejś magii;

Rzekomo nie można takiej procedury zadeklarować (na kształt Write), bo jest ona wbudowana w kompilator:

Writeln is what we call a compiler "magic" function. If you look in System.pas, you won't find a Writeln that is declared anything like what you would expect. The compiler literally breaks it all down into individual calls to various special runtime library functions.

In short, there is no way to implement your own version that does all the same things as the built-in writeln without modifying the compiler.

http://stackoverflow.com/questions/617654/how-does-writeln-really-work

Od bardzo dawna zastanawiam się w jaki sposób można takie coś wykonać, jednak jeszcze nie udało mi się; Zrobić coś w rodzaju Format to pikuś, ale własnego Write raczej nie można zrobić; Więc z zabawy odpadam i czekam na Twoją wersję (chyba, że łamałeś kompilator :D ).

0
_13tg_Dragon napisał(a)

Albo wysyłać je do @Patryk27 na PW ostatniego dnia sam wklei i ogłosi wyniki.

Tak też można - więc drobna zmiana: rozwiązania wysyłajcie na PW, a 10 IX ogłoszę wyniki i wkleję kody, które otrzymałem ;)

0

a jednak nie - pomysł upadł :/

2

Żeby podgrzać atmosferę orzekam, że brakuje mi tylko obsługi double.

0

Proponuję poszerzyć możliwości o drukowanie double w kodowaniu binarnym,
znacz np. liczba 2.75 będzie drukowana tak: 10.11

Byłoby to nawet niekiedy użyteczne - można sprawdzać jaka jest faktycznie dana liczba a nie tylko zaokrąglenie do iluś cyfr dziesiętnych.

double x = 0.7;

i nie wiadomo co tam siedzi, w szczególności czy to jest większe od 0.7, czy też mniejsze.

1/2 + 1/4 = 0.75, za dużo
1/2 + 1/8 + 1/16 = 0.6875

0.10110011001100... chyba tak wyjdzie.

3/4 + 3/4 /16 + ... = 3/4 (1 + 1/16 + 1/16^2 + ... ) = 3/4 1/(1 - 1/16) = 3/4 16/15 = 4/5 = 0.8

zgadza się: 0.7 = 0.5 + 0.8/4

0

Game Over :D

4

Przyszła pora na rozwiązanie konkursu i ukazanie kodów! :)
(technicznie pozostały jeszcze niecałe 3 godziny, no ale...)

Jedyną osobą, która przesłała rozwiązanie był @Azarien (właściwie, to przesłał mi dwa (nieco podobne) rozwiązania).
Bez zbędnego przeciągania:

Azarien #1: http://4programmers.net/Pastebin/2413
To jest o tyle ciekawe, że korzysta z zewnętrznego wywoływania printf, więc, mimo że jest to nieco droga na około, to właśnie dzięki niej jest to interesujące podejście ;)

Azarien #2: http://4programmers.net/Pastebin/2414
Ten kod spełnia wszystkie wymogi i działa (testowane przez Azariena na FPC 2.4.0 pod x86, potwierdzone przeze mnie również we FPC 2.6.3 na x86 W8).

Niestety nie otrzymałem więcej kodów (chociaż pisał do mnie również @olesio), więc - jak obiecałem - dodam swoją wersję kodu (który nawiasem mówiąc jest podobny do wersji Azariena) i wytłumaczę o co w nim chodzi, tym samym również tłumacząc kod Azarienowy.

Type pint32 = ^int32;

Procedure println(const Format: String); cdecl; external; varargs;

Procedure __internal_println(const Format: String); cdecl; [Public, Alias: '_println'];
Var Text: String = '';
    Tmp : String;
    Arg : Pointer;
    Pos : uint16 = 1;
    Len : uint16;
Begin
 Arg := Pointer(uint32(@Format) + sizeof(String));
 Len := Length(Format);

 While (Pos <= Len) Do
 Begin
  { %int32 }
  if (Copy(Format, Pos, 6) = '%int32') Then
  Begin
   Str(pint32(Arg)^, Tmp);
   Text += Tmp;

   Inc(Pos, 6);
   Inc(Arg, sizeof(int32));
  End Else

  { %pchar }
  if (Copy(Format, Pos, 6) = '%pchar') Then
  Begin
   Text += PPChar(Arg)^;

   Inc(Pos, 6);
   Inc(Arg, sizeof(PChar));
  End Else

  { %double }
  if (Copy(Format, Pos, 7) = '%double') Then
  Begin
   Str(PDouble(Arg)^:0:15, Tmp);

   if (System.Pos('.', Tmp) > 0) Then
   Begin
    While (Tmp[Length(Tmp)] = '0') Do
     Delete(Tmp, Length(Tmp), 1);

    if (Tmp[Length(Tmp)] = '.') Then
     Delete(Tmp, Length(Tmp), 1);
   End;

   Text += Tmp;

   Inc(Pos, 7);
   Inc(Arg, sizeof(Double));
  End Else

  Begin
   Text += Format[Pos];
   Inc(Pos);
  End;
 End;

 Writeln(Text);
End;

Var A: int32 = 512;
    B: PChar = 'Hello!';
    C: Double = 123.456;
Begin
 println('A = %int32 | B = %pchar | C = %double | 55 = %int32', A, B, C, int32(55));
// Readln;
End.

Zastosowałem rozwiązanie podobne do tricku, który użył @Azarien - słowem-klucz do rozwiązania tego konkursu była znajomość modyfikatora varargs.
Jego prawdziwym zastosowaniem było ułatwienie (im)portowania funkcji z C/C++ do Pascala - w jaki sposób?
Naturalnie w C++ istnieją magiczne Variadic functions - są to funkcje, które mogą przyjąć bliżej nieskończenie dużą liczbę argumentów. Przykładem takiej najczęściej używanej funkcji jest printf - jej definicja wygląda następująco:

int printf(const char *format, ...);

Ten wielokropek oznacza, że funkcja przyjmuje jeden wymagany argument format, a wszystkie następujące po nim są opcjonalne - mogą być dowolnego typu oraz może ich być nieskończenie wiele (lub zero).
Deklaracja tej funkcji znajduje się (w przypadku Windowsa) w bibliotece msvcrt.dll - powstaje jednak pytanie: jak powinna wyglądać jej definicja w Pascalu (gdybyśmy ją chcieli wywołać z naszego kodu)? Przecież nie możemy po prostu napisać:

Function printf(const Format: PChar; ...): Integer;

I właśnie tutaj z pomocą przychodzi varargs:

Function printf(const Format: PChar): Integer; varargs; cdecl; external 'msvcrt.dll';

To varargs sprawia, że funkcja przyjmie po ostatnim jawnym zdefiniowanym parametrze (czyli tutaj tym Format), dodatkowo od zera do bliżej nieskończenie wielu parametrów dodatkowych.
To była pierwsza część wymaganej wiedzy, by móc rozwiązać ten konkurs.

Lecz sprawa nie jest taka prosta - jak powiedziałem: ten keyword został zaprojektowany, by umożliwić importowanie takich C-owych printfów, więc wymaga on bycia połączonym z external, nie może zostać od-tak zastosowany do jakiejkolwiek funkcji/procedury; innymi słowy, taki kod nie jest poprawny:

Procedure printf(const Format: PChar); varargs;
Begin
 cośtam
End;

I tutaj przychodzi druga część "wymaganej wiedzy", czyli pojęcie o istnieniu modyfikatora alias.
Ten z kolei modyfikator umożliwia zmianę nazwy funkcji z punktu widzenia linkera - jako że kompilator zawsze* nazwę funkcji "tłumaczy" na coś bardziej linker-friendly (patrz: name mangling), czasami zajdzie potrzeba, aby funkcja/procedura miała dokładnie wyznaczoną przez nas nazwę, a nie coś w stylu ?h@@YAXH@Z (gdy np.łączymy zewnętrzne wstawki Assemblera z naszym kodem).
Można by pomyśleć "no okej, ale jak nam to tutaj pomaga?" - otóż odpowiem, że bardzo.
Na przykładzie mojego kodu:

Procedure println(const Format: String); cdecl; external; varargs;

Tą linijką informujemy kompilator, że gdzieś-tam zadeklarowana jest funkcja println i nie musi się o nią martwić (zajmie się tym dopiero linker, z punktu widzenia kompilatora ta funkcja jako-tako 'nie istnieje' - znamy jedynie jej nagłówek, lecz nie wiemy, jak wygląda jej ciało/zawartość - identycznie, jak gdybyśmy importowali funkcję z biblioteki).
Jak widać - użyłem tutaj varargs oraz external;, które oznacza, że ciało tej funkcji znajduje się w tym samym pliku/projekcie, który aktualnie jest kompilowany (a będzie linkowany).
Dalej widzimy:

Procedure __internal_println(const Format: String); cdecl; [Public, Alias: '_println'];

Znaczy to, że deklarujemy funkcję o nazwie w kodzie __internal_println, która jednak po procesie kompilacji (w pliku wynikowym) nazywać się będzie _println. Pragnąłbym zauważyć, że właśnie dwie linijki wyżej informujemy kompilator (oraz linker), że funkcji o "wewnętrznej" (z punktu widzenia linkera 'rzeczywistej') nazwie println (a właściwie to _println) ma oczekiwać w momencie wywoływania println(parametry); (fachowo nazywa się to "relokacjami", gdyby ktoś nie wiedział).
Skąd jednak wziął się ten _ na początku nazwy? Cóż, po prostu println jest na Windowsie przez FPC zamieniane na _println w pliku wyjściowym, tak już jest. Dla porównania już w przypadku Linuxa byłoby to po prostu println, bez dodatkowego znaku underscore. Ot, taka konwencja.

Czyli kwestię nagłówka mamy załatwioną - pozostaje ostatni problem: jak dobrać się do parametrów?
Spójrzmy na konwencję wywoływania - jest to cdecl, czyli parametry przekazywane są na stos od prawej do lewej.
Znaczy to tyle, że pierwszy parametr znajduje się w pamięci (na stosie) na pozycji @Format, drugi parametr znajduje się sizeof(String) bajtów dalej, czyli @Format+1 (lub jak ja preferuję: Pointer(uint32(@Format) + sizeof(String))), następny znajduje się o sizeof(aktualny parametr) bajtów dalej od tego i tak dalej. Zauważyć należy, że nie znamy typów żadnego z tych parametrów (ani nawet nie wiemy, czy rzeczywiście się tam znajdują) - przez cały czas bazujemy wyłącznie na ciągu znaków przekazanym przez użytkownika i zakładamy, że jest on poprawny (czyli nie zrobił czegoś w stylu println('x=%pchar', int32(1024));
Wobec tego w swojej funkcji najpierw przypisuję do wskaźnika adres na pierwszy parametr przekazany w wywołaniu przez programistę:

Arg := Pointer(uint32(@Format) + sizeof(String));

I przesuwam ten wskaźnik odpowiednio o sizeof(uint32), sizeof(PChar) lub sizeof(Double) bajtów dalej za każdym parametrem, zgodnie z danymi zapisanymi w formacie (parametrze Format).
@Azarien robi właściwie to samo, lecz w swojej wersji on operuje na PLongWord (u mnie jest to zwykły Pointer), zatem on zwiększa wartości o sizeof(uint32)/sizeof(LongWord), sizeof(PChar)/sizeof(LongWord) i tak dalej.

Cóż, i to chyba tyle magii w naszych kodach :D
Prawdę mówiąc, to gdyby nie @Azarien, to sam nie znałbym tej sztuczki (w którymś z tematów - może z rok, dwa lata temu - wspomniał on o tym w jednym ze swoich postów w moim temacie i sobie to zapamiętałem - byłem ciekaw, kto jeszcze to zna ;)).
Oprócz przedstawionych przez nas rozwiązań, istnieje wciąż (przynajmniej) jedna metoda rozwiązania tego zadania-konkursu, tym razem bez korzystania z varargs i prawie w 100% przenośnie: można stworzyć każdy wariant funkcji println dla parametrów uint32, PChar i Double, których liczba wynosi od zera do piętnastu (stąd celowo ująłem taką małą wartość w zasadach i jasno napisałem, że nie wymagane jest tworzenie żadnych dodatkowych int8, UnicodeStringów i całej tej reszty; myślałem, że ktoś na to wpadnie i podeśle mi taki "schizowy" kod - swoją drogą, wciąż pozostały 3 godziny, ktoś się podejmie? :D).

tl;dr
@Azarien wygrywa szacunek na całej dzielni i satysfakcję z wygranej, brawo! ;)
Jeżeli mi jeszcze jakieś ciekawe zadania wpadną na myśl, to na pewno się z Wami podzielę, a póki co... well... dzięki za udział w konkursie + mam nadzieję, że może jakiegoś programistę dzięki temu konkursowi zapoznałem/-liśmy z ciekawą varargs-owo-alias-ową sztuczką ;>


`*` no, prawie zawsze. Zależnie od samego kompilatora, docelowej architektury/systemu oraz zastosowanych przełączników.
0

Brawo dla zwycięzcy. Ja niestety nie znalazłem czasu i dostatecznej motywacji na napisanie własnej implemwntacji. Jednak była by ona podobna do funkcji FormatC z moich kodów w WinAPI, którą kiedyś wygooglowałem, a która znajduje się w module useful_winapi.pas, który nie raz tutaj publikowałem.

Do obsługi parametrów użył bym również varargs. Z tym, że nie użył bym sprintf jak w FormatC, tylko printf, ponieważ tylko ta chyba z funkcji API korzysta z %f i pozwala obsłużyć typ Double. Musiał bym tylko ogarnąć do końca varargs, ponieważ wygooglowana FormatC jest funkcją i aby zwrócić rezultat potrzebuje bufora typu Char, który musi być jakoś ograniczony jako tablica statuyczna, a przynajmniej w takiej postaci go kiedyś znalazłem.

A o identyfikatorze alias chyba w Delphi do tej pory nie słyszałem albo nie pamiętam.

0

Heh, nie znałem tego modyfikatora (varargs), ale dużo Googlowałem i wiedziałem, że w nim na pewno leży rozwiązanie; Jednak wszystko co znalazłem to jedynie import funkcji printf z bibliotek systemu (np. tutaj) ale stwierdziłem, że nie tędy droga, bo miała być własna funkcja, a nie zaimportowana z systemu;

Mimo wszystko pierwotnie napisałem działające rozwiązanie, jednak niedokładnie przeczytałem punkt 3 (i kilka innych informacji) z pierwszego postu i myślałem, że to ma być własny odpowiednik funkcji Format... Napialiłem się, a później cofałem to, że mam rozwiązanie gotowe;

Naskrobałem kod, który działa dokładnie tak, jak funkcja Format, ale dodatkowo pomija nieobsługiwane litery typów (np. %a); Jeśli ktoś jest zainteresowany - kod dostępny tutaj; Gdybym nie zorientował się, że źle zinterpretowałem treść zadania, pozmieniałbym %d na %int32, %f na %double i %s na %pchar i wysłał kod do Patryka dalej myśląc, że rozwiązałem zadanie;


No nic, dzięki temu konkursowi dowiedziałem się więcej na temat modyfikatora varargs i jego zastosowania w praktyce; Cieszę się, że po tak długim czasie zastanawiania się jak zrobić taką funkcję dostałem gotowca :]

Gratuluję zwycięzcy, dobra robota @Azarien.

0

Przecież nie możemy po prostu napisać:

Function printf(const Format: PChar; ...): Integer;

I właśnie tutaj z pomocą przychodzi varargs:

Function printf(const Format: PChar): Integer; varargs; cdecl; external 'msvcrt.dll';

Możemy też pod Free Pascalem (ale nie pod Delphi!) zrobić:

Function printf(const Format: PChar; args:array of const): Integer; cdecl; external 'msvcrt.dll';

i przekazywać dodatkowe parametry objęte w nawiasy kwadratowe:

printf('%d %s %d', [2, 'ala ma kota', 47]);

To jednak nie przejdzie pod Delphi. Pod FPC natomiast array of const w połączeniu z cdecl jest kompatybilne z varargs.

pierwszy parametr znajduje się w pamięci (na stosie) na pozycji @Format, drugi parametr znajduje się sizeof(String) bajtów dalej,
W swojej wersji kodu użyłem dyrektywy {$H+} (pełna forma: {$ANSISTRINGS ON}, co powoduje, że string staje się kompatybilny z pcharem (mniej więcej), czyli jest wskaźnikiem — dzięki czemu moje %pchar obsługiwało nie tylko pchar ale też string.

0

Tak przy okazji - alias nie jest jedyną metodą rozwiązania tego zadania:

Procedure my_function(const Format: PChar); cdecl;
Begin
 Writeln(Format);
 Writeln(PInteger(@Format+4)^);
End;

Type TProc = Procedure(const Format: PChar) cdecl varargs;
Var Proc: TProc;
Begin
 Proc := TProc(@my_function);

 Proc('foo', Integer(1024));
// Readln;
End.

To już jest rozwiązanie bardziej przenośne, ponieważ nie wymaga korzystania z linker-magic (thx payl, nie wpadłem na skorzystanie z wskaźnika na funkcję - głównie dlatego, że już miałem z FPC problemy w połączeniu variable-functions z varargs-ami :P).

Azarien napisał(a)

W swojej wersji kodu użyłem dyrektywy {$H+} (pełna forma: {$ANSISTRINGS ON}, co powoduje, że string staje się kompatybilny z pcharem (mniej więcej), czyli jest wskaźnikiem — dzięki czemu moje %pchar obsługiwało nie tylko pchar ale też string.

Warto dodać, że dyrektywa {$H} działa jedynie w obrębie aktualnie kompilowanego pliku, a nie projektu.

0

Gratuluje i zazdroszczę wiedzy. Oby jak najwiecej takich eventów!

0

Ja natknąłem się na temat @Patryk27 i wiedziałem, że pójdzie tym tropem, ale w zanadrzu miałem jeszcze jednego asa , który jak się szybko okazało stał się niewypałem - z uwagi na ograniczenie 15 parametrów chciałem napisać funkcję która przyjmuje argumenty typu variant z wartością domyślną dla pozostałych 14 opcjonalnych jednak okazuje się, że nie można nadać wartości domyślnej typom niestandardowym - taka funkcja byłaby znacznie bezpieczniejsza niż poleganie na stringu wzorcowym, ale cóż :/

2

Wiem, że wątek jest już wiekowy. Ale go odgrzebie. Poniżej moja propozycja gdyby ktoś chciał powyższy kod zastosować pod WinAPI w Delphi rozszerzony o proste formatowania intów i hexów plus poprawiony nieco Double, gdyż pod Delphi 7 nie spełniał się warunek o usuwaniu zer "końcowych". Odkopałem to dopiero teraz, gdyż pomyślałem, że w końcu się mi to przyda.

Może macie jakieś jeszcze propozycje. I możecie doradzić, bo zawsze mam z tym problem czy przy użyciu sprintf nie ma wyceków pamięci. Albo może da się jeszcze coś poprawić i zrobić lepiej. Moim założeniem jest to aby kod działał ok pod WinAPI i Delphi 7. Z pobieżnych testów wynika, że raczej jest ok.

Na pewno jest to lepsze rozwiązanie niż wygooglowanie przeze mnie kiedys FormatC korzystające ze sztywnego bufora którego rozmiar musimy podać w kodzie. Tamten kod nie obsługujące również floatów, bo odwołujące się do wvsprintfA który nie ma obsługi takowych.

program test;

{$APPTYPE CONSOLE}

uses
  Windows;

type
  pint32 = ^integer;

function sprintf(S : PAnsiChar; const Format : PAnsiChar) : integer; cdecl;
varargs; external 'msvcrt.dll';

function __Internal_SimpleFormat(const Format : string) : string; cdecl;
var
  PC : PChar;
  Tmp : string;
  Arg : Pointer;
  Pos, Len : UINT;
begin
  Pos := 1;
  Result := '';
  Arg := Pointer(Uint(@Format) + sizeof(string));
  Len := Length(Format);
  while (Pos <= Len) do
  begin
    if (Copy(Format, Pos, 2) = '%d')
      or (Copy(Format, Pos, 4) = '%.2d')
      or (Copy(Format, Pos, 4) = '%.3d')
      or (Copy(Format, Pos, 4) = '%.4d')
      or (Copy(Format, Pos, 4) = '%.5d')
      or (Copy(Format, Pos, 4) = '%.6d')
      or (Copy(Format, Pos, 4) = '%.7d')
      or (Copy(Format, Pos, 4) = '%.8d') then
    begin
      GetMem(PC, 20);
      if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
      begin
        sprintf(PC, PChar(Copy(Format, Pos, 2)), pint32(Arg)^);
      end
      else
      begin
        sprintf(PC, PChar(Copy(Format, Pos, 4)), pint32(Arg)^);
      end;
      Result := Result + PC;
      FreeMem(PC);
      if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
      begin
        Inc(Pos, 2);
      end
      else
      begin
        Inc(Pos, 4);
      end;
      Arg := PChar(Arg) + SizeOf(integer);
    end
    else
    begin
      if (Copy(Format, Pos, 2) = '%s') then
      begin
        Result := Result + PPChar(Arg)^;
        Inc(Pos, 2);
        Arg := PChar(Arg) + SizeOf(PChar);
      end
      else
      begin
        if (Copy(Format, Pos, 2) = '%f') then
        begin
          Str(PDouble(Arg)^ : 0 : 10, Tmp);
          if (System.Pos('.', Tmp) > 0) then
          begin
            while (Tmp[Length(Tmp)] = '0') do
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
            if (Tmp[Length(Tmp)] = '.') then
            begin
              Delete(Tmp, Length(Tmp), 1);
            end;
          end;
          Result := Result + Tmp;
          Inc(Pos, 2);
          Arg := PChar(Arg) + SizeOf(Double);
        end
        else
        begin
          if (Copy(Format, Pos, 2) = '%x')
            or (Copy(Format, Pos, 2) = '%X')
            or (Copy(Format, Pos, 4) = '%.2x')
            or (Copy(Format, Pos, 4) = '%.3x')
            or (Copy(Format, Pos, 4) = '%.4x')
            or (Copy(Format, Pos, 4) = '%.5x')
            or (Copy(Format, Pos, 4) = '%.6x')
            or (Copy(Format, Pos, 4) = '%.7x')
            or (Copy(Format, Pos, 4) = '%.8x')
            or (Copy(Format, Pos, 4) = '%.2X')
            or (Copy(Format, Pos, 4) = '%.3X')
            or (Copy(Format, Pos, 4) = '%.4X')
            or (Copy(Format, Pos, 4) = '%.5X')
            or (Copy(Format, Pos, 4) = '%.6X')
            or (Copy(Format, Pos, 4) = '%.7X')
            or (Copy(Format, Pos, 4) = '%.8X') then
          begin
            GetMem(PC, 20);
            if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
            begin
              sprintf(PC, PChar(Copy(Format, Pos, 2)), pint32(Arg)^);
            end
            else
            begin
              sprintf(PC, PChar(Copy(Format, Pos, 4)), pint32(Arg)^);
            end;
            Result := Result + PC;
            FreeMem(PC);
            if System.Pos('.', Copy(Format, Pos, 2)) <> 2 then
            begin
              Inc(Pos, 2);
            end
            else
            begin
              Inc(Pos, 4);
            end;
            Arg := PChar(Arg) + SizeOf(DWORD);
          end
          else
          begin
            Result := Result + Format[Pos];
            Inc(Pos);
          end;
        end;
      end;
    end;
  end;
end;

var
  SimpleFormat : function(const Format : string) : string; cdecl varargs = __Internal_SimpleFormat;

var
  A : integer = 512;
  B : string = 'Hello!';
  C : Double = 123.456;
begin
  Writeln(SimpleFormat('A = %d | B = %s | C = %f | Hex = %.8X | koniec.', A, B, C, $3A9E));
  Readln;
end.

Dorzucam jeszcze w postaci osobnego modułu. Przedrostkiem useful na ogół nazywam sobie użyteczne moduły. Podczas pisania w Delphi 7, czegoś co nie używa w ogóle VCL.

0

Te zlepki instrukcji Copy nie wyglądają najlepiej; Ale póki co nie mam pomysłu jak to zastąpić, więc spróbuję przeanalizować kod o jakiejś ludzkiej porze :]

0

No fakt. Nie wygląda to idealnie, ale też nie miałem pomysłu na to. Bazowałem na oryginalnym kodzie. Poza tym nie pomyślałem też, że trzeba by jeszcze dla pewności inteligentnie obsłużyć systuacje gdy przed danym %cosik jest %%cosik, czyli na przykład %%s. Wtedy należało by wypisać samo %s. A może ktoś z Was ma jeszcze pomysł, jak to udoskonalić? Podzielcie się swoimi pomysłami na usprawnienie mojego kodu. Póki co zrobiłem tak jak w załączniku. Wygląda ok, ale pewnie ds się efektowniej.

1 użytkowników online, w tym zalogowanych: 0, gości: 1