Recent

Author Topic: Does anyone have the idea to improve my DIY c2pas for Convert C to Pascal?  (Read 1499 times)

TYDQ

  • Full Member
  • ***
  • Posts: 176
These days I have developed my c2pas by myself with lazarus and fpc.However,I cannot improve my c2pas further due to I have no idea about doing some improvement.
My c2pas repository is on https://github.com/TYDQSoft/c2pas/tree/main,You can also download binaries from github to use without recompile.
I am demanding some useful advise for my c2pas converter,please try it to give some suggestion to me.
If you don't want to go to github for my source code,you can download the attachment below.
(For Example,Support of decltype(exp) is not supported yet,it will be supported in further version of my c2pas)
I am just improving my c2pas,NOT for advertisement for my DIY c2pas.
« Last Edit: February 23, 2025, 10:59:43 am by TYDQ »

d2010

  • Sr. Member
  • ****
  • Posts: 264
Re: Does anyone have the idea to improve my DIY c2pas for Convert C to Pascal?
« Reply #1 on: February 24, 2025, 11:31:31 am »
Please you develope, a library.zip *.with many demos.
Please you attach a iink, for any user/s can upload his demo.cpp
 ;D
You develop a new version of "procedure prehandler_handle2010(var content:string);"|
Code: [Select]
procedure prehandler_handle(var content:string);
var i,j,len:SizeInt;
begin
 {Delete the /**/ comments}
 i:=1; len:=length(content);
 while(i<len) do
  begin
   if(content[i]<=' ') and (content[i]<>#10) and (content[i]<>#13) then content[i]:=' '
   else if(content[i]=#13) then content[i]:=' ';
   inc(i);
  end;
You replace "
Code: [Select]
   if(Copy(content,i,2)='/*') then" with
  (content[[i]='/') and (contet[[i+1]='*') then
If any onlineuser- got 100% succesfully, then he can upload to you, for update your
 library.zip
You replace    if(Copy(content,i,2)='//') then
   (content='/') and (contet[i+1]='/') then
Eu tie multumesc ArsenieBoca 2025
Code: [Select]
     while(j<=len-1) and (Copy(content,j,2)<>'*/') do inc(j);
     Delete(content,i,j-i+2); dec(len,j-i+2); continue;
-------- become
     while(j<=len-1) and (content[j]<>'*')and((content[j+1]<>'/') do inc(j);
     Delete(content,i,j-i+2); dec(len,j-i+2); continue;
« Last Edit: February 24, 2025, 06:27:40 pm by d2010 »

Boleeman

  • Hero Member
  • *****
  • Posts: 1158
Re: Does anyone have the idea to improve my DIY c2pas for Convert C to Pascal?
« Reply #2 on: February 27, 2025, 10:23:19 am »
Hi TYDQ.

I came across this C-To-Delphi converter ages ago. Made by Wouter Van Nifterick:
https://github.com/WouterVanNifterick/C-To-Delphi/

I remember trying it out when I had Delphi installed, with mixed results.
Ended up uninstalling the free version of Delphi, as the trial period elapsed and I ended up using Lazarus as it was free and seemed to work better for me.

The zipped and compiled exe 2,29 Mb is here:
https://github.com/WouterVanNifterick/C-To-Delphi/releases

Latest version is v0.9.2 (I had v0.9.0 which is attached below). Perhaps try out v0.9.2 from Github.

Perhaps you may get some ideas from it.


Also by the same Dutch guy:
PACC (PAscal C Compiler) is an C compiler, which is implemented in Delphi-7-compatible Object Pascal
https://github.com/WouterVanNifterick/pacc
« Last Edit: February 27, 2025, 10:35:17 am by Boleeman »

Boleeman

  • Hero Member
  • *****
  • Posts: 1158
Re: Does anyone have the idea to improve my DIY c2pas for Convert C to Pascal?
« Reply #3 on: February 27, 2025, 11:31:31 am »
And luck has it ...

I stumbled across this one accidentally just now:

This is a simple console utility that can convert C/C++ headers to Pascal sources compatible with Delphi and FreePascal/Lazarus.

https://github.com/yunkot/HeaderParser



Boleeman

  • Hero Member
  • *****
  • Posts: 1158
Re: Does anyone have the idea to improve my DIY c2pas for Convert C to Pascal?
« Reply #4 on: February 27, 2025, 02:42:06 pm »
And a few older ones:


C to Pascal source code converter
https://github.com/DrDiettrich/CtoPas

C to Pascal source code converter
WinToPas is a Delphi(7) GUI project, to create D7 units from C source files (*.c, *.h).
The C parser is almost C99 compatible, with some C11 extensions.
It requires standard header files of a compiler, Cygwin may be sufficient.
The code generator outputs D7 units, as far as Delphi syntax allows.

OpenC2Pas is a C/C++/BCB to Object Pascal (Delphi/Kylix) translator.
https://sourceforge.net/projects/c2pas/



C_C++_Syntax_vs_Pascal
https://www.cs.gordon.edu/courses/cs320/handouts/C_C++_Syntax_vs_Pascal.html



Pascal to C++ converter
https://github.com/knizhnik/ptoc

Converter recognizes Pascal dialects which are compatible with
Turbo Pascal 4.0/5.0 and ISO Pascal standard - IEC 7185:1990(E)
(including conformant arrays).
Converter can produce both C++ and C output. Using of C++ language allows
to encapsulate some Pascal types and constructions into C++ classes.
So mapping between Pascal and C++ becomes more direct
then between Pascal and C. I use C++ templates to implement Pascal arrays
and files. Special template classes are used for conformant arrays.
C++ like streams are used to implement Pascal IO routines.
The same runtime library is used both for C and C++.





ubuntu h2pas-3.0.0.1
https://manpages.ubuntu.com/manpages/xenial/man1/h2pas-3.0.0.1.html

h2pas  attempts  to  convert  a C header file to a pascal unit.  it can handle most C constructs that one
       finds in a C header file, and attempts to translate them to their pascal counterparts. see the CONSTRUCTS
       section for a full description of what the translator can handle.




PtoC
https://github.com/knizhnik/ptoc
http://www.garret.ru/ptoc/Readme.htm
http://www.garret.ru/ptoc354.zip
http://www.garret.ru/ptoc361.zip
http://www.garret.ru/~knizhnik

This is yet another Pascal to C/C++ converter. The primary idea of this converter is to produce readable and supportable code which preserves style of original code as far as possible.

Converter recognizes Pascal dialects which are compatible with Turbo Pascal 4.0/5.0 and ISO Pascal standard - IEC 7185:1990(E) (including conformant arrays). At this moment it was tested with Turbo Pascal, Oregon Pascal, Sun Pascal and HP Pascal.





https://www.softpedia.com/get/Programming/Other-Programming-Files/C-to-Pascal-Converter.shtml
https://www.softpedia.com/get/Programming/Other-Programming-Files/C-to-Pascal-Converter.shtml#download
n order to have the C files converted to Pascal code no configurations are required, just by pressing 'Run' the process will start and go on automatically. For those who want to edit or search something inside a loaded file, this program offers some simple commands that can prove quite useful.

The application can function in two modes when performing the conversions and from the 'Project' menu you can switch between them easily. Thus, it is possible to convert one file at a time, in the so-called 'single use mode', or several at once if the 'Project Mode' is set active.






C Header Translator for Delphi
https://github.com/neslib/Chet
https://blog.grijjy.com/2018/05/29/chet-a-c-header-translator-powered-by-clang/
https://blog.grijjy.com/2018/05/15/libclang-for-delphi/

Translates C data types such as structs, union, enums, typedefs, procedural types and opaque types.
Translates C functions to Delphi procedures or functions.
Tries to translate #define declarations to constants where possible.
Generates a single .pas file for an entire directory of .h files. This reduces issues due to dependencies between header files.
Generates output for multiple platforms (Winsows, macOS, Linux, iOS and Android) if desired.
Customize the Clang parsing process by supplying command line arguments to the compiler.
Customize the output of some conversion operations.
Retains any Doxygen style documentation comments if desired, or converts them to XmlDoc comments or PasDoc comments.
Provides a GUI for configuring the conversion process, and allows you to save the conversion settings to a .chet project file for reuse.




Conversion Helper Package
http://rvelthuis.de/zips/convertpack.zip
For the conversion of API headers from C or C++ to Delphi
http://rvelthuis.de/programs/convertpack.html



Dr.Bob's HeadConv - C DLL Header Converter v4.20

http://www.ebob42.com/ftp/headconv.zip

HeadConv has full support for functions and procedures, argument and return types (128 custom type conversions) and generates implicit Delphi import units. The expert is integrated in the Delphi IDE, making the conversion very easy as the converted file is opened up in the IDE automatically. At this time there is limited (non-complex) support for typedefs, structs, unions, enums and conditional compilations. HeadConv is not targeted to do the conversion 100% on its own, rather it will assist in converting the C DLL header files

d2010

  • Sr. Member
  • ****
  • Posts: 264
Code: [Select]
LRESULT CALLBACK WndProc(
                HWND hWnd,         // window handle
                UINT message,      // type of message
                WPARAM uParam,     // additional information
                LPARAM lParam)     // additional information
{
  char dtexted[52];
  SetLastError(0); // Set error flag to "no errors"
  getvar_menuname = GetMenu(hWnd);
  dtexted[0]='\0';
  dtexted[1]='\0';
  switch (message) {
    case WM_CREATE:  // Select an big Arial font into our DC
    {
    HDC hDC = GetDC(hWnd);
                LOGFONT lf;
HFONT hf;

    memset(&lf, 0, sizeof(LOGFONT));
    lf.lfHeight = -72; // Big fonts scale better
        strcpy((LPSTR)&(lf.lfFaceName), "arial");
         
    // Create and select the font
    hf = CreateFontIndirect(&lf);
    SelectObject(hDC, hf);

hpenBlue = CreatePen(PS_SOLID, 1, RGB(0,0,255));
hpenRed  = CreatePen(PS_SOLID, 1, RGB(255,0,0));
}

GetLastErrorBox(hWnd, "Error in WM_CREATE");
break;

case WM_PAINT:
            {
   PAINTSTRUCT ps;
   HDC hDC = BeginPaint(hWnd, &ps);
               RECT rect;
                   
   // Clear the client area
               GetClientRect(hWnd, &rect);
               PatBlt(hDC, 0, 0, rect.right, rect.bottom, WHITENESS);
           
       
       // If we have something to show...
       if (dwTop && dwBot) {

       // Show the top guide line if we have one and the user wants to
       if (dwTop && bShowGuides) {
                     SelectObject(hDC, hpenBlue);
                     ShowGuide(hDC, lpTop, dwTop);
                     SelectObject(hDC, GetStockObject(BLACK_PEN));
                   }
   
       // If we have a bottom guide line
       if (dwBot) {                     
       
               // ...then show it if the use wants to
               if (bShowGuides) {
                 SelectObject(hDC, hpenRed);
                         ShowGuide(hDC, lpBot, dwBot);
            SelectObject(hDC, GetStockObject(BLACK_PEN));
                       }      
               // Do the mapping and show the text
                           ZeroMemory(dtexted,sizeof(dtexted));
                           strncpy(dtexted,pszText,sizeof(dtexted)-4);
               TextEffect(hDC, lpTop, lpBot, dwTop, dwBot,dtexted,
                           bOutlineOnly);
                   }
               }

               EndPaint(hWnd, &ps);
}
            break;

case WM_LBUTTONDOWN: // Read a guide line from the user
            {
               HDC hDC = GetDC(hWnd);                   
               RECT rect;   
               
               if (bOn) {
                   GetClientRect(hWnd, &rect);
                   
                   // Clear the screen
                   PatBlt(hDC, 0, 0, rect.right, rect.bottom, WHITENESS);
                   
                   // Get rid of the previous guide lines
                   if (lpTop)
                     GlobalFree(lpTop);
                   if (lpBot)
                     GlobalFree(lpBot);
       dwBot = 0;

             SelectObject(hDC, hpenBlue);  // Top guide line is blue
                   GetGuideLine(hWnd, &lpTop, &dwTop);
               }
               else {
                   SelectObject(hDC, hpenRed); // Bottom guide line is red
                   GetGuideLine(hWnd, &lpBot, &dwBot);
               }
               
               // Black as night, black as coal, I want to see the sun blotted out from the sky...
               SelectObject(hDC, GetStockObject(BLACK_PEN));
               bOn = !bOn;

   if (bOn) { 

                  // Expand the line segment into points
          FillOut(&lpTop, &dwTop,"A103");
                  FillOut(&lpBot, &dwBot,"A104");

                  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
               }
            }  

GetLastErrorBox(hWnd, "Error in WM_LBUTTONDOWN");
            break;
       
        case WM_COMMAND:
            wmId    = LOWORD(uParam);
            wmEvent = HIWORD(uParam);

            switch (wmId) {
                                case IDM_QUICKTEST128:
                                        Quicker(hWnd);
                                        break;

case IDM_QUICKTEST:  // Randomly generate guide lines
    {
  RECT rect;
  int i;
 
  bOn = TRUE;  // Reset to top guide line

  GetClientRect(hWnd, &rect);
  if (dwTop)
    GlobalFree(lpTop);
  if (dwBot)
    GlobalFree(lpBot);
 
  // Allocate top guide line
  lpTop = (LPPOINT)GlobalAlloc(GPTR, sizeof(POINT) * QUICKTESTPOINTS);
  if (!lpTop) break;
 
  // Allocate bottom guide line
  lpBot = (LPPOINT)GlobalAlloc(GPTR, sizeof(POINT) * QUICKTESTPOINTS);
  if (!lpBot) {
    GlobalFree(lpTop);
break;
  }
 
  // Generate points
  for (i=0; i<QUICKTESTPOINTS; i++) {
    lpTop[i].x = random(rect.right);
                        lpTop[i].y = random(rect.bottom);
lpBot[i].x = random(rect.right);
                        lpBot[i].y = random(rect.bottom);
  }
 
  // Set number of points for top and bottom lines
  dwTop = QUICKTESTPOINTS;
  dwBot = QUICKTESTPOINTS;
 
  // Expand the line segment into points
                      FillOut(&lpTop, &dwTop,"A105");
                                      FillOut(&lpBot, &dwBot,"A106");
                              InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                                      php_str_marquee=RTNORM;
}

GetLastErrorBox(hWnd, "Error in IDM_QUICKTEST"); 
break;

            case IDM_CHOOSEFONT: // Let the user pick a font
{
   HDC hDC = GetDC(hWnd);
                       HFONT hf;
   LOGFONT lf;
   CHOOSEFONT cf;
                           
       ZeroMemory(&cf, sizeof(cf)); 
   ZeroMemory(&lf, sizeof(lf)); 
   
   cf.lStructSize = sizeof(CHOOSEFONT);
   cf.lpLogFont = &lf;
                       cf.Flags = CF_SCREENFONTS | CF_TTONLY;
   
   if (ChooseFont(&cf)) {
                           lf.lfHeight = -72;    // Bigger fonts look better
       hf = CreateFontIndirect(&lf);
                           DeleteObject(SelectObject(hDC, hf));
   }
        }

        // If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_CHOOSEFONT");
        break;

                                case IDM_SETPERIODIC:
                                       php_str_marquee=(php_str_marquee<0)?RTNORM:RTCAN;
                                       CheckMenuItem(GetMenu(hWnd),IDM_SETPERIODIC, (php_str_marquee==RTNORM) ? MF_CHECKED : MF_UNCHECKED);
       if (dwTop && dwBot)  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                                       GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                                       break;

                                case IDM_LINEFILLSTYLE:
                                       AcGiLineFillStyle = 1 - AcGiLineFillStyle;
                                       SetWindowText(IDM_LINEFILLSTYLE,(AcGiLineFillStyle==0)?"kSlant_Left":"kSlant_Right");
                                       GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                                       break;

case IDM_SHOWGUIDES:  // User toggled guide display
                                          bShowGuides = !bShowGuides;
                                          CheckMenuItem(GetMenu(hWnd), IDM_SHOWGUIDES, bShowGuides ? MF_CHECKED : MF_UNCHECKED);
// If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                    break;
 
case IDM_OUTLINE:   // User toggled display of text as outline
                    bOutlineOnly = !bOutlineOnly;
                    CheckMenuItem(GetMenu(hWnd), IDM_OUTLINE, bOutlineOnly ? MF_CHECKED : MF_UNCHECKED);

// If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_OUTLINE");
                    break;

                case IDM_ABOUT:
                    DialogBox(hInst,          // current instance
                             "ABOUTBOX",      // dlg resource to use
                             hWnd,            // parent handle
                             (DLGPROC)About); // About() instance address

                    break;

               
                case IDM_EXIT:
                    DestroyWindow (hWnd);
                    break;

                default:
                    return (DefWindowProc(hWnd, message, uParam, lParam));
            }
            break;

        case WM_TIMER :
               if (AcGiLineFillStyle==1) kSlant_Right();
                      else kSlant_Left();

               if (php_str_marquee==RTNORM)
                  { FillOut(&lpTop, &dwTop,"A107");
                    FillOut(&lpBot, &dwBot,"A108");
                    if ((dwBot<2) || (dwTop<2)) { php_str_marquee=RTREJ;
                                                  CheckMenuItem(GetMenu(hWnd),IDM_SETPERIODIC, (php_str_marquee==RTNORM) ? MF_CHECKED : MF_UNCHECKED);
                                                 }
                      else   InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                  };
               break;

        case WM_DESTROY:  // message: window being destroyed
                KillTimer (hWnd, ID_TIMER) ;
                PostQuitMessage(0);
                break;
   
        default:          // Passes it on if unproccessed
                return (DefWindowProc(hWnd, message, uParam, lParam));
}
return (0);
}
These days I have developed my c2pas by myself with lazarus and fpc.However,I cannot improve my c2pas further due to I have no idea about doing some improvement.
My c2pas repository is on


Next Step  for your project(I think?)
You (or other .e.g d2010) tdevelope many demosntrations
You increase inc100 to inc999
You increase out100. to out999
You share with other/s , a same/simliary .zip
This solution "case" to many if/s is good solution.
 :-X
Thank you
Thank you
Thank you
Thank you
Code: [Select]
Function iWndproc(Wndmgr: HWND; message: UINT;  uParam: WPARAM;  lParam: windows.LPARAM): LRESULT; stdcall;
 var dtexted:array[0..51] of Char;
    hDC1:HDC;
    lf:windows.TLOGFONTA;
    hf:HFONT;
    ps:TPAINTSTRUCT;
    rect:TRECT;
    i:Integer;
    wmId, wmEvent:integer;
    cfr:TCHOOSEFONT;
 begin
 SetLastError(0);
 Getvar_menuname:=GetMenu(integer(Wndmgr));
 dtexted[0]:=#00;
 dtexted[1]:=#00;
 repeat
   if(message=WM_CREATE)then
    begin
     ZeroMemory(@lf,sizeof(TLOGFONTA));
     lf.lfHeight:=-72;
     lf.lfFaceName:='arial';
     hf:=CreateFontIndirect(lf);
     SelectObject(hDC1,hf);
     hpenBlue:=CreatePen(PS_SOLID,1,RGB(0,0,255));
     hpenRed:=CreatePen(PS_SOLID,1,RGB(255,0,0));
     GetLastErrorBox(Wndmgr,'Error in WM_CREATE');
     break;
    end;

   if(message=WM_PAINT)then
    begin
     GetClientRect(Wndmgr,rect);
     PatBlt(hDC1,0,0,rect.right,rect.bottom,WHITENESS);
     if(dwTop>00) and (dwBot>00)then
      begin
       if((dwTop>00) and bShowGuides)then
        begin
         SelectObject(hDC1,hpenBlue);
         ShowGuide(hDC1,lpTop,dwTop,255,0,255);
         SelectObject(hDC1,GetStockObject(BLACK_PEN));
        end;
       if(dwBot>00)then
        begin
         if(bShowGuides)then
          begin
           SelectObject(hDC1,hpenRed);
           ShowGuide(hDC1,lpBot,dwBot,0,255,255);
           SelectObject(hDC1,GetStockObject(BLACK_PEN));
          end;
         TextEffect(hDC1,lpTop.lpPoints,lpBot.lpPoints,dwTop,dwBot,vla_AddMText,bOutlineOnly);
        end;
      end;
     EndPaint(WndMGR,ps);
     break;
    end;

   if(message=WM_LBUTTONDOWN)then
    begin
     if(bOn)then
      begin
       GetClientRect(WndMGR,rect);
       PatBlt(hDC1,0,0,rect.right,rect.bottom,WHITENESS);
       if(lpTop.lpPoints<>nil)then
        begin
         GlobalFree(integer(lpTop.lpPoints));
         lpTop.lpPoints:=nil;
        end;
       if(lpBot.lpPoints<>nil)then
        begin
         GlobalFree(integer(lpBot.lpPoints));
         lpBot.lpPoints:=nil;
        end;
       dwBot:=0;
       SelectObject(hDC1,hpenBlue);
       GetGuideLine(Wndmgr,lpTop,dwTop);
      end
     else
      begin
       SelectObject(hDC1,hpenRed);
       GetGuideLine(Wndmgr,lpBot,dwBot);
      end;
     SelectObject(hDC1,GetStockObject(BLACK_PEN));
     bOn:=not bOn;
     if(bOn)then
      begin
       FillOut(lpTop.lpPoints,dwTop,'A103');
       FillOut(lpBot.lpPoints,dwBot,'A104');
       InvalidateRect(Wndmgr,nil,FALSE);
      end;
     GetLastErrorBox(Wndmgr,'Error in WM_LBUTTONDOWN');
     break;
    end;

   if(message=WM_COMMAND)then
    begin
     wmId:=LOWORD(uParam);
     wmEvent:=HIWORD(uParam);
     repeat
      begin
       if(wmId=IDM_QUICKTEST128)then
        begin
         Quicker(Wndmgr);
         break;
        end;
       if(wmId=IDM_QUICKTEST)then
        begin
         bOn:=TRUE;
         GetClientRect(Wndmgr,rect);

         if(dwTop>00) then
          begin   if (lptop.lpPoints<>nil) then  GlobalFree(integer(lpTop.lpPoints));
                   dwTop:=00;
                   lpTop.lpPoints:=nil;
          end;
         if(dwBot>000)then
          begin
                if (lpBot.lpPoints<>nil) then  GlobalFree(integer(lpBot.lpPoints));
                     lpBot.lpPoints:=nil;
                     dwBot:=00;
         end;
         lpTop.lpPoints:=pointer(GlobalAlloc(GPTR,sizeof(TPOINT)*QUICKTESTPOINTS));
         if(lpTop.lpPoints=nil)then
          begin
           dwBot:=00;
           break;
          end;
         lpBot.lpPoints:=pointer(GlobalAlloc(GPTR,sizeof(TPOINT)*QUICKTESTPOINTS));
         if(lpBot.lpPoints=nil)then
          begin dwBot:=00;
                GlobalFree(integer(lpBot.lpPoints));
                lpBot.lpPoints:=nil;
           break;
          end;
         i:=0;
         while(i<QUICKTESTPOINTS)do
          begin
           lpTop.lpPoints[i].x:=random(rect.right);
           lpTop.lpPoints[i].y:=random(rect.right);
           lpBot.lpPoints[i].x:=random(rect.right);
           lpBot.lpPoints[i].y:=random(rect.right);
           inc(i);
          end;
         dwTop:=QUICKTESTPOINTS;
         dwBot:=QUICKTESTPOINTS;
         FillOut(lpTop.lpPoints,dwTop,'A105');
         FillOut(lpBot.lpPoints,dwBot,'A106');
         InvalidateRect(Wndmgr,nil,FALSE);
         php_str_marquee:=RTNORM;
         GetLastErrorBox(Wndmgr,'Error in IDM_QUICKTEST');
         break;
        end;
       if(wmId=IDM_CHOOSEFONT)then
        begin
         ZeroMemory(@lf,sizeof(lf));
         ZeroMemory(@cfr,sizeof(cfr));

         cfr.lStructSize:=sizeof(CHOOSEFONT);
         cfr.lpLogFont:=@lf;
         cfr.Flags:=CF_SCREENFONTS or CF_TTONLY;
         if(ChooseFont(cfr))then
          begin
           lf.lfHeight:=-72;
           hf:=CreateFontIndirect(lf);
           DeleteObject(SelectObject(hDC1,hf));
          end;
         if(dwTop>000) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_CHOOSEFONT');
         break;
        end;
       if(wmId=IDM_SETPERIODIC)then
        begin
        php_str_marquee:=RTCAN;
        //    CheckMenuItem(GetMenu(Wnd),IDM_SETPERIODIC,MF_UNCHECKED);
CheckMenuItem(Getvar_menuname,IDM_SETPERIODIC,MF_UNCHECKED);
         if(dwTop>00) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_LINEFILLSTYLE)then
        begin
         AcGiLineFillStyle:=1-AcGiLineFillStyle;
         SetWindowText(IDM_LINEFILLSTYLE,'kSlant_Right');
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_SHOWGUIDES)then
        begin
         bShowGuides:=not bShowGuides;
         CheckMenuItem(Getvar_menuname,IDM_SHOWGUIDES,MF_CHECKED);
         if(dwTop>00) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_OUTLINE)then
        begin
         bOutlineOnly:=not bOutlineOnly;
         CheckMenuItem(Getvar_menuname,IDM_OUTLINE,MF_CHECKED);
         if(dwTop>00 )and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_OUTLINE');
         break;
        end;
       if(wmId=IDM_ABOUT)then
        begin
//         DialogBox(hInst,'ABOUTBOX',hWnd,DLGPROC(About));
         break;
        end;
       if(wmId=IDM_EXIT)then
        begin
         DestroyWindow(Wndmgr);
         break;
        end;

        begin
        Result:=DefWindowProc(Wndmgr,message,uParam,lParam);
         exit;
        end;
      end;
     until(False);
     break;
    end;
   if(message=WM_TIMER)then
    begin
     if(AcGiLineFillStyle=1)then
      begin
       kSlant_Right();
      end
     else
      begin
       kSlant_Left();
      end;
     if(php_str_marquee=RTNORM)then
      begin
       FillOut(lpTop.lpPoints,dwTop,'A107');
       FillOut(lpBot.lpPoints,dwBot,'A108');
       if(dwBot<2 )or (dwTop<2 )then
        begin
         php_str_marquee:=RTREJ;
         CheckMenuItem(Getvar_menuname,IDM_SETPERIODIC,MF_UNCHECKED);
        end
       else
        begin
         InvalidateRect(Wndmgr,nil,FALSE);
        end;
      end;
     break;
    end;
   if(message=WM_DESTROY)then
    begin
     KillTimer(Wndmgr,1);
     PostQuitMessage(0);
     break;
    end;
    Result:=DefWindowProc(Wndmgr,message,uParam,lParam);
     exit;
 until(False);
 result:=00;
end;
« Last Edit: March 07, 2025, 04:44:36 pm by d2010 »

TYDQ

  • Full Member
  • ***
  • Posts: 176
Code: [Select]
LRESULT CALLBACK WndProc(
                HWND hWnd,         // window handle
                UINT message,      // type of message
                WPARAM uParam,     // additional information
                LPARAM lParam)     // additional information
{
  char dtexted[52];
  SetLastError(0); // Set error flag to "no errors"
  getvar_menuname = GetMenu(hWnd);
  dtexted[0]='\0';
  dtexted[1]='\0';
  switch (message) {
    case WM_CREATE:  // Select an big Arial font into our DC
    {
    HDC hDC = GetDC(hWnd);
                LOGFONT lf;
HFONT hf;

    memset(&lf, 0, sizeof(LOGFONT));
    lf.lfHeight = -72; // Big fonts scale better
        strcpy((LPSTR)&(lf.lfFaceName), "arial");
         
    // Create and select the font
    hf = CreateFontIndirect(&lf);
    SelectObject(hDC, hf);

hpenBlue = CreatePen(PS_SOLID, 1, RGB(0,0,255));
hpenRed  = CreatePen(PS_SOLID, 1, RGB(255,0,0));
}

GetLastErrorBox(hWnd, "Error in WM_CREATE");
break;

case WM_PAINT:
            {
   PAINTSTRUCT ps;
   HDC hDC = BeginPaint(hWnd, &ps);
               RECT rect;
                   
   // Clear the client area
               GetClientRect(hWnd, &rect);
               PatBlt(hDC, 0, 0, rect.right, rect.bottom, WHITENESS);
           
       
       // If we have something to show...
       if (dwTop && dwBot) {

       // Show the top guide line if we have one and the user wants to
       if (dwTop && bShowGuides) {
                     SelectObject(hDC, hpenBlue);
                     ShowGuide(hDC, lpTop, dwTop);
                     SelectObject(hDC, GetStockObject(BLACK_PEN));
                   }
   
       // If we have a bottom guide line
       if (dwBot) {                     
       
               // ...then show it if the use wants to
               if (bShowGuides) {
                 SelectObject(hDC, hpenRed);
                         ShowGuide(hDC, lpBot, dwBot);
            SelectObject(hDC, GetStockObject(BLACK_PEN));
                       }      
               // Do the mapping and show the text
                           ZeroMemory(dtexted,sizeof(dtexted));
                           strncpy(dtexted,pszText,sizeof(dtexted)-4);
               TextEffect(hDC, lpTop, lpBot, dwTop, dwBot,dtexted,
                           bOutlineOnly);
                   }
               }

               EndPaint(hWnd, &ps);
}
            break;

case WM_LBUTTONDOWN: // Read a guide line from the user
            {
               HDC hDC = GetDC(hWnd);                   
               RECT rect;   
               
               if (bOn) {
                   GetClientRect(hWnd, &rect);
                   
                   // Clear the screen
                   PatBlt(hDC, 0, 0, rect.right, rect.bottom, WHITENESS);
                   
                   // Get rid of the previous guide lines
                   if (lpTop)
                     GlobalFree(lpTop);
                   if (lpBot)
                     GlobalFree(lpBot);
       dwBot = 0;

             SelectObject(hDC, hpenBlue);  // Top guide line is blue
                   GetGuideLine(hWnd, &lpTop, &dwTop);
               }
               else {
                   SelectObject(hDC, hpenRed); // Bottom guide line is red
                   GetGuideLine(hWnd, &lpBot, &dwBot);
               }
               
               // Black as night, black as coal, I want to see the sun blotted out from the sky...
               SelectObject(hDC, GetStockObject(BLACK_PEN));
               bOn = !bOn;

   if (bOn) { 

                  // Expand the line segment into points
          FillOut(&lpTop, &dwTop,"A103");
                  FillOut(&lpBot, &dwBot,"A104");

                  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
               }
            }  

GetLastErrorBox(hWnd, "Error in WM_LBUTTONDOWN");
            break;
       
        case WM_COMMAND:
            wmId    = LOWORD(uParam);
            wmEvent = HIWORD(uParam);

            switch (wmId) {
                                case IDM_QUICKTEST128:
                                        Quicker(hWnd);
                                        break;

case IDM_QUICKTEST:  // Randomly generate guide lines
    {
  RECT rect;
  int i;
 
  bOn = TRUE;  // Reset to top guide line

  GetClientRect(hWnd, &rect);
  if (dwTop)
    GlobalFree(lpTop);
  if (dwBot)
    GlobalFree(lpBot);
 
  // Allocate top guide line
  lpTop = (LPPOINT)GlobalAlloc(GPTR, sizeof(POINT) * QUICKTESTPOINTS);
  if (!lpTop) break;
 
  // Allocate bottom guide line
  lpBot = (LPPOINT)GlobalAlloc(GPTR, sizeof(POINT) * QUICKTESTPOINTS);
  if (!lpBot) {
    GlobalFree(lpTop);
break;
  }
 
  // Generate points
  for (i=0; i<QUICKTESTPOINTS; i++) {
    lpTop[i].x = random(rect.right);
                        lpTop[i].y = random(rect.bottom);
lpBot[i].x = random(rect.right);
                        lpBot[i].y = random(rect.bottom);
  }
 
  // Set number of points for top and bottom lines
  dwTop = QUICKTESTPOINTS;
  dwBot = QUICKTESTPOINTS;
 
  // Expand the line segment into points
                      FillOut(&lpTop, &dwTop,"A105");
                                      FillOut(&lpBot, &dwBot,"A106");
                              InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                                      php_str_marquee=RTNORM;
}

GetLastErrorBox(hWnd, "Error in IDM_QUICKTEST"); 
break;

            case IDM_CHOOSEFONT: // Let the user pick a font
{
   HDC hDC = GetDC(hWnd);
                       HFONT hf;
   LOGFONT lf;
   CHOOSEFONT cf;
                           
       ZeroMemory(&cf, sizeof(cf)); 
   ZeroMemory(&lf, sizeof(lf)); 
   
   cf.lStructSize = sizeof(CHOOSEFONT);
   cf.lpLogFont = &lf;
                       cf.Flags = CF_SCREENFONTS | CF_TTONLY;
   
   if (ChooseFont(&cf)) {
                           lf.lfHeight = -72;    // Bigger fonts look better
       hf = CreateFontIndirect(&lf);
                           DeleteObject(SelectObject(hDC, hf));
   }
        }

        // If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_CHOOSEFONT");
        break;

                                case IDM_SETPERIODIC:
                                       php_str_marquee=(php_str_marquee<0)?RTNORM:RTCAN;
                                       CheckMenuItem(GetMenu(hWnd),IDM_SETPERIODIC, (php_str_marquee==RTNORM) ? MF_CHECKED : MF_UNCHECKED);
       if (dwTop && dwBot)  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                                       GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                                       break;

                                case IDM_LINEFILLSTYLE:
                                       AcGiLineFillStyle = 1 - AcGiLineFillStyle;
                                       SetWindowText(IDM_LINEFILLSTYLE,(AcGiLineFillStyle==0)?"kSlant_Left":"kSlant_Right");
                                       GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                                       break;

case IDM_SHOWGUIDES:  // User toggled guide display
                                          bShowGuides = !bShowGuides;
                                          CheckMenuItem(GetMenu(hWnd), IDM_SHOWGUIDES, bShowGuides ? MF_CHECKED : MF_UNCHECKED);
// If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_SHOWGUIDES");
                    break;
 
case IDM_OUTLINE:   // User toggled display of text as outline
                    bOutlineOnly = !bOutlineOnly;
                    CheckMenuItem(GetMenu(hWnd), IDM_OUTLINE, bOutlineOnly ? MF_CHECKED : MF_UNCHECKED);

// If we have text to show then re-render it
if (dwTop && dwBot)
  InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT

GetLastErrorBox(hWnd, "Error in IDM_OUTLINE");
                    break;

                case IDM_ABOUT:
                    DialogBox(hInst,          // current instance
                             "ABOUTBOX",      // dlg resource to use
                             hWnd,            // parent handle
                             (DLGPROC)About); // About() instance address

                    break;

               
                case IDM_EXIT:
                    DestroyWindow (hWnd);
                    break;

                default:
                    return (DefWindowProc(hWnd, message, uParam, lParam));
            }
            break;

        case WM_TIMER :
               if (AcGiLineFillStyle==1) kSlant_Right();
                      else kSlant_Left();

               if (php_str_marquee==RTNORM)
                  { FillOut(&lpTop, &dwTop,"A107");
                    FillOut(&lpBot, &dwBot,"A108");
                    if ((dwBot<2) || (dwTop<2)) { php_str_marquee=RTREJ;
                                                  CheckMenuItem(GetMenu(hWnd),IDM_SETPERIODIC, (php_str_marquee==RTNORM) ? MF_CHECKED : MF_UNCHECKED);
                                                 }
                      else   InvalidateRect(hWnd, NULL, FALSE);  // Draw the text via WM_PAINT
                  };
               break;

        case WM_DESTROY:  // message: window being destroyed
                KillTimer (hWnd, ID_TIMER) ;
                PostQuitMessage(0);
                break;
   
        default:          // Passes it on if unproccessed
                return (DefWindowProc(hWnd, message, uParam, lParam));
}
return (0);
}
These days I have developed my c2pas by myself with lazarus and fpc.However,I cannot improve my c2pas further due to I have no idea about doing some improvement.
My c2pas repository is on


Next Step  for your project(I think?)
You (or other .e.g d2010) tdevelope many demosntrations
You increase inc100 to inc999
You increase out100. to out999
You share with other/s , a same/simliary .zip
This solution "case" to many if/s is good solution.
 :-X
Thank you
Thank you
Thank you
Thank you
Code: [Select]
Function iWndproc(Wndmgr: HWND; message: UINT;  uParam: WPARAM;  lParam: windows.LPARAM): LRESULT; stdcall;
 var dtexted:array[0..51] of Char;
    hDC1:HDC;
    lf:windows.TLOGFONTA;
    hf:HFONT;
    ps:TPAINTSTRUCT;
    rect:TRECT;
    i:Integer;
    wmId, wmEvent:integer;
    cfr:TCHOOSEFONT;
 begin
 SetLastError(0);
 Getvar_menuname:=GetMenu(integer(Wndmgr));
 dtexted[0]:=#00;
 dtexted[1]:=#00;
 repeat
   if(message=WM_CREATE)then
    begin
     ZeroMemory(@lf,sizeof(TLOGFONTA));
     lf.lfHeight:=-72;
     lf.lfFaceName:='arial';
     hf:=CreateFontIndirect(lf);
     SelectObject(hDC1,hf);
     hpenBlue:=CreatePen(PS_SOLID,1,RGB(0,0,255));
     hpenRed:=CreatePen(PS_SOLID,1,RGB(255,0,0));
     GetLastErrorBox(Wndmgr,'Error in WM_CREATE');
     break;
    end;

   if(message=WM_PAINT)then
    begin
     GetClientRect(Wndmgr,rect);
     PatBlt(hDC1,0,0,rect.right,rect.bottom,WHITENESS);
     if(dwTop>00) and (dwBot>00)then
      begin
       if((dwTop>00) and bShowGuides)then
        begin
         SelectObject(hDC1,hpenBlue);
         ShowGuide(hDC1,lpTop,dwTop,255,0,255);
         SelectObject(hDC1,GetStockObject(BLACK_PEN));
        end;
       if(dwBot>00)then
        begin
         if(bShowGuides)then
          begin
           SelectObject(hDC1,hpenRed);
           ShowGuide(hDC1,lpBot,dwBot,0,255,255);
           SelectObject(hDC1,GetStockObject(BLACK_PEN));
          end;
         TextEffect(hDC1,lpTop.lpPoints,lpBot.lpPoints,dwTop,dwBot,vla_AddMText,bOutlineOnly);
        end;
      end;
     EndPaint(WndMGR,ps);
     break;
    end;

   if(message=WM_LBUTTONDOWN)then
    begin
     if(bOn)then
      begin
       GetClientRect(WndMGR,rect);
       PatBlt(hDC1,0,0,rect.right,rect.bottom,WHITENESS);
       if(lpTop.lpPoints<>nil)then
        begin
         GlobalFree(integer(lpTop.lpPoints));
         lpTop.lpPoints:=nil;
        end;
       if(lpBot.lpPoints<>nil)then
        begin
         GlobalFree(integer(lpBot.lpPoints));
         lpBot.lpPoints:=nil;
        end;
       dwBot:=0;
       SelectObject(hDC1,hpenBlue);
       GetGuideLine(Wndmgr,lpTop,dwTop);
      end
     else
      begin
       SelectObject(hDC1,hpenRed);
       GetGuideLine(Wndmgr,lpBot,dwBot);
      end;
     SelectObject(hDC1,GetStockObject(BLACK_PEN));
     bOn:=not bOn;
     if(bOn)then
      begin
       FillOut(lpTop.lpPoints,dwTop,'A103');
       FillOut(lpBot.lpPoints,dwBot,'A104');
       InvalidateRect(Wndmgr,nil,FALSE);
      end;
     GetLastErrorBox(Wndmgr,'Error in WM_LBUTTONDOWN');
     break;
    end;

   if(message=WM_COMMAND)then
    begin
     wmId:=LOWORD(uParam);
     wmEvent:=HIWORD(uParam);
     repeat
      begin
       if(wmId=IDM_QUICKTEST128)then
        begin
         Quicker(Wndmgr);
         break;
        end;
       if(wmId=IDM_QUICKTEST)then
        begin
         bOn:=TRUE;
         GetClientRect(Wndmgr,rect);

         if(dwTop>00) then
          begin   if (lptop.lpPoints<>nil) then  GlobalFree(integer(lpTop.lpPoints));
                   dwTop:=00;
                   lpTop.lpPoints:=nil;
          end;
         if(dwBot>000)then
          begin
                if (lpBot.lpPoints<>nil) then  GlobalFree(integer(lpBot.lpPoints));
                     lpBot.lpPoints:=nil;
                     dwBot:=00;
         end;
         lpTop.lpPoints:=pointer(GlobalAlloc(GPTR,sizeof(TPOINT)*QUICKTESTPOINTS));
         if(lpTop.lpPoints=nil)then
          begin
           dwBot:=00;
           break;
          end;
         lpBot.lpPoints:=pointer(GlobalAlloc(GPTR,sizeof(TPOINT)*QUICKTESTPOINTS));
         if(lpBot.lpPoints=nil)then
          begin dwBot:=00;
                GlobalFree(integer(lpBot.lpPoints));
                lpBot.lpPoints:=nil;
           break;
          end;
         i:=0;
         while(i<QUICKTESTPOINTS)do
          begin
           lpTop.lpPoints[i].x:=random(rect.right);
           lpTop.lpPoints[i].y:=random(rect.right);
           lpBot.lpPoints[i].x:=random(rect.right);
           lpBot.lpPoints[i].y:=random(rect.right);
           inc(i);
          end;
         dwTop:=QUICKTESTPOINTS;
         dwBot:=QUICKTESTPOINTS;
         FillOut(lpTop.lpPoints,dwTop,'A105');
         FillOut(lpBot.lpPoints,dwBot,'A106');
         InvalidateRect(Wndmgr,nil,FALSE);
         php_str_marquee:=RTNORM;
         GetLastErrorBox(Wndmgr,'Error in IDM_QUICKTEST');
         break;
        end;
       if(wmId=IDM_CHOOSEFONT)then
        begin
         ZeroMemory(@lf,sizeof(lf));
         ZeroMemory(@cfr,sizeof(cfr));

         cfr.lStructSize:=sizeof(CHOOSEFONT);
         cfr.lpLogFont:=@lf;
         cfr.Flags:=CF_SCREENFONTS or CF_TTONLY;
         if(ChooseFont(cfr))then
          begin
           lf.lfHeight:=-72;
           hf:=CreateFontIndirect(lf);
           DeleteObject(SelectObject(hDC1,hf));
          end;
         if(dwTop>000) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_CHOOSEFONT');
         break;
        end;
       if(wmId=IDM_SETPERIODIC)then
        begin
        php_str_marquee:=RTCAN;
        //    CheckMenuItem(GetMenu(Wnd),IDM_SETPERIODIC,MF_UNCHECKED);
CheckMenuItem(Getvar_menuname,IDM_SETPERIODIC,MF_UNCHECKED);
         if(dwTop>00) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_LINEFILLSTYLE)then
        begin
         AcGiLineFillStyle:=1-AcGiLineFillStyle;
         SetWindowText(IDM_LINEFILLSTYLE,'kSlant_Right');
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_SHOWGUIDES)then
        begin
         bShowGuides:=not bShowGuides;
         CheckMenuItem(Getvar_menuname,IDM_SHOWGUIDES,MF_CHECKED);
         if(dwTop>00) and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_SHOWGUIDES');
         break;
        end;
       if(wmId=IDM_OUTLINE)then
        begin
         bOutlineOnly:=not bOutlineOnly;
         CheckMenuItem(Getvar_menuname,IDM_OUTLINE,MF_CHECKED);
         if(dwTop>00 )and (dwBot>00)then
          begin
           InvalidateRect(Wndmgr,nil,FALSE);
          end;
         GetLastErrorBox(Wndmgr,'Error in IDM_OUTLINE');
         break;
        end;
       if(wmId=IDM_ABOUT)then
        begin
//         DialogBox(hInst,'ABOUTBOX',hWnd,DLGPROC(About));
         break;
        end;
       if(wmId=IDM_EXIT)then
        begin
         DestroyWindow(Wndmgr);
         break;
        end;

        begin
        Result:=DefWindowProc(Wndmgr,message,uParam,lParam);
         exit;
        end;
      end;
     until(False);
     break;
    end;
   if(message=WM_TIMER)then
    begin
     if(AcGiLineFillStyle=1)then
      begin
       kSlant_Right();
      end
     else
      begin
       kSlant_Left();
      end;
     if(php_str_marquee=RTNORM)then
      begin
       FillOut(lpTop.lpPoints,dwTop,'A107');
       FillOut(lpBot.lpPoints,dwBot,'A108');
       if(dwBot<2 )or (dwTop<2 )then
        begin
         php_str_marquee:=RTREJ;
         CheckMenuItem(Getvar_menuname,IDM_SETPERIODIC,MF_UNCHECKED);
        end
       else
        begin
         InvalidateRect(Wndmgr,nil,FALSE);
        end;
      end;
     break;
    end;
   if(message=WM_DESTROY)then
    begin
     KillTimer(Wndmgr,1);
     PostQuitMessage(0);
     break;
    end;
    Result:=DefWindowProc(Wndmgr,message,uParam,lParam);
     exit;
 until(False);
 result:=00;
end;
I will look for some time to improve my c2pas with your advice.

TYDQ

  • Full Member
  • ***
  • Posts: 176
And a few older ones:


C to Pascal source code converter
https://github.com/DrDiettrich/CtoPas

C to Pascal source code converter
WinToPas is a Delphi(7) GUI project, to create D7 units from C source files (*.c, *.h).
The C parser is almost C99 compatible, with some C11 extensions.
It requires standard header files of a compiler, Cygwin may be sufficient.
The code generator outputs D7 units, as far as Delphi syntax allows.

OpenC2Pas is a C/C++/BCB to Object Pascal (Delphi/Kylix) translator.
https://sourceforge.net/projects/c2pas/



C_C++_Syntax_vs_Pascal
https://www.cs.gordon.edu/courses/cs320/handouts/C_C++_Syntax_vs_Pascal.html



Pascal to C++ converter
https://github.com/knizhnik/ptoc

Converter recognizes Pascal dialects which are compatible with
Turbo Pascal 4.0/5.0 and ISO Pascal standard - IEC 7185:1990(E)
(including conformant arrays).
Converter can produce both C++ and C output. Using of C++ language allows
to encapsulate some Pascal types and constructions into C++ classes.
So mapping between Pascal and C++ becomes more direct
then between Pascal and C. I use C++ templates to implement Pascal arrays
and files. Special template classes are used for conformant arrays.
C++ like streams are used to implement Pascal IO routines.
The same runtime library is used both for C and C++.





ubuntu h2pas-3.0.0.1
https://manpages.ubuntu.com/manpages/xenial/man1/h2pas-3.0.0.1.html

h2pas  attempts  to  convert  a C header file to a pascal unit.  it can handle most C constructs that one
       finds in a C header file, and attempts to translate them to their pascal counterparts. see the CONSTRUCTS
       section for a full description of what the translator can handle.




PtoC
https://github.com/knizhnik/ptoc
http://www.garret.ru/ptoc/Readme.htm
http://www.garret.ru/ptoc354.zip
http://www.garret.ru/ptoc361.zip
http://www.garret.ru/~knizhnik

This is yet another Pascal to C/C++ converter. The primary idea of this converter is to produce readable and supportable code which preserves style of original code as far as possible.

Converter recognizes Pascal dialects which are compatible with Turbo Pascal 4.0/5.0 and ISO Pascal standard - IEC 7185:1990(E) (including conformant arrays). At this moment it was tested with Turbo Pascal, Oregon Pascal, Sun Pascal and HP Pascal.





https://www.softpedia.com/get/Programming/Other-Programming-Files/C-to-Pascal-Converter.shtml
https://www.softpedia.com/get/Programming/Other-Programming-Files/C-to-Pascal-Converter.shtml#download
n order to have the C files converted to Pascal code no configurations are required, just by pressing 'Run' the process will start and go on automatically. For those who want to edit or search something inside a loaded file, this program offers some simple commands that can prove quite useful.

The application can function in two modes when performing the conversions and from the 'Project' menu you can switch between them easily. Thus, it is possible to convert one file at a time, in the so-called 'single use mode', or several at once if the 'Project Mode' is set active.






C Header Translator for Delphi
https://github.com/neslib/Chet
https://blog.grijjy.com/2018/05/29/chet-a-c-header-translator-powered-by-clang/
https://blog.grijjy.com/2018/05/15/libclang-for-delphi/

Translates C data types such as structs, union, enums, typedefs, procedural types and opaque types.
Translates C functions to Delphi procedures or functions.
Tries to translate #define declarations to constants where possible.
Generates a single .pas file for an entire directory of .h files. This reduces issues due to dependencies between header files.
Generates output for multiple platforms (Winsows, macOS, Linux, iOS and Android) if desired.
Customize the Clang parsing process by supplying command line arguments to the compiler.
Customize the output of some conversion operations.
Retains any Doxygen style documentation comments if desired, or converts them to XmlDoc comments or PasDoc comments.
Provides a GUI for configuring the conversion process, and allows you to save the conversion settings to a .chet project file for reuse.




Conversion Helper Package
http://rvelthuis.de/zips/convertpack.zip
For the conversion of API headers from C or C++ to Delphi
http://rvelthuis.de/programs/convertpack.html



Dr.Bob's HeadConv - C DLL Header Converter v4.20

http://www.ebob42.com/ftp/headconv.zip

HeadConv has full support for functions and procedures, argument and return types (128 custom type conversions) and generates implicit Delphi import units. The expert is integrated in the Delphi IDE, making the conversion very easy as the converted file is opened up in the IDE automatically. At this time there is limited (non-complex) support for typedefs, structs, unions, enums and conditional compilations. HeadConv is not targeted to do the conversion 100% on its own, rather it will assist in converting the C DLL header files
There is still have some problems in my c2pas,I will look for some available time to fix it or remake it.

 

TinyPortal © 2005-2018