Recent

Recent Posts

Pages: 1 2 [3] 4 5 ... 10
21
General / Re: Parameter passing oddities
« Last post by alpine on Today at 06:16:58 pm »
Quote
But all that would not be necessary if there was a method of passing parameters which works like const but avoids the "constant" assumption. I don't know how other languages handle this. Just feel something is missing in Pascal.
I know only two methods: by-value and by-reference (without involving pointers, of course). AFAIK const parameters is to retain by-value semantics with an additional twist:
Quote
Declaring a parameter as const allows the compiler the possibility to do optimizations it couldn't do otherwise, such as passing by reference while retaining the semantics of passing by value.
   
Passing by-ref are var and constref.
What do you mean by "if there was a method of passing parameters which works like const..."?
22
Suggestions / Re: add new targets to make
« Last post by Key-Real on Today at 06:04:22 pm »
still the same

Code: Pascal  [Select][+][-]
  1. $ make rtl CPU_TARGET=mipsel OS_TARGET=ps1 FPC=/run/media/key-real/E3AF-F107/code/source/compiler/ppcrossmipsel
  2. make -C rtl all
  3. make[1]: Entering directory '/run/media/key-real/E3AF-F107/code/source/rtl'
  4. make[1]: Nothing to be done for 'all'.
  5. make[1]: Leaving directory '/run/media/key-real/E3AF-F107/code/source/rtl'
  6.  


see attachment
23
Operating Systems / Re: Unlocking Files
« Last post by KodeZwerg on Today at 06:03:08 pm »
To be honest, on a windows machine I would use the windows api.
I have not checked what RenameFile() does do but this is how I would do:
Code: Pascal  [Select][+][-]
  1. function MyRenameFile(const OldName, NewName: WideString): Boolean;
  2. var
  3.   OldNameW, NewNameW: PWideChar;
  4. begin
  5.   OldNameW := PWideChar(OldName);
  6.   NewNameW := PWideChar(NewName);
  7.   Result := MoveFileW(OldNameW, NewNameW);
  8. end;
  9.  
  10. begin
  11.   if MyRenameFile('OldFileName.txt', 'NewFileName.txt') then
  12.     WriteLn('File renamed successfully.')
  13.   else
  14.     WriteLn('Failed to rename file.');
  15. end.
Extend that snipped with error handling like the link is suggesting.
My example assume that OldFileName.txt does exists and NewFileName.txt not.
That the destination folder exists and your process got write permission.
24
FPC development / Re: trunk compiler bug for mipsel raised exception internally - Access violation
« Last post by Key-Real on Today at 05:56:32 pm »
Yes, Finally!

the system and the fpintres units have to be precompiled!

I would wish me a reasonable error message from the compiler to avoid all this discussion
25
Graphics / Demo Scene Bitmap Font Scroller
« Last post by Gigatron on Today at 05:56:27 pm »
Hi L&G,

I will try to share a bitmap font scroller using BGRABitmap, you will learn how to scroll text.
Bitmap font from the champs cracktro Amiga;

https://www.youtube.com/watch?v=05C-iyxoqLs

The Result in LP :
https://www.youtube.com/watch?v=puFsvBfmIoA

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; uplaysound;
  10.  
  11. const
  12.   ascii : Array [0..58] of integer = (26,37,99,99,99,99,99,41,42,43,99,99,44,99,38,99,27,28,29,30,31,32,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
  13.   cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
  14.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
  15.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
  16.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
  17.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
  18.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
  19.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
  20.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
  21.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
  22.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
  23.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
  24.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
  25.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
  26.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
  27.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
  28.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
  29.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
  30.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
  31.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
  32.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
  33.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
  34.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
  35.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
  36.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
  37.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
  38.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
  39.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
  40.                                             '#000099','#000088','#000077');
  41.  
  42. var
  43.   CharImage: TBGRABitmap;
  44.   ScrollSpeed: integer = 2;
  45.   ScrollCounter: integer = 1;
  46.   CharWidth : integer = 30;
  47.   CharW     : integer = 30;
  48.   CharHeight :  integer = 48;
  49.   CharsPerLine : integer = 240;
  50.   ScrollText : String = '                  ....       GIGATRON THE LEADER PRESENTS BITMAP FONT SCROLLER DEMO CODED WITH LAZARUS PASCAL GREETINGS TO PUMA, JAGUAR, SERVAL, LYNX, CARACAL, PANTHER, OCELOT, CHEETAH, WILD CAT,  ...  FONT FROM THE CHAMPS CRACKTRO AMIGA IN 1988  RELEASE DATE LATE ON (( 22.04.2024 ))     SEE YOU    .....';
  51.   hexColor: string;
  52.   red, green, blue: Byte;
  53.   j,pause,snd_timer  : integer;
  54.  
  55. type
  56.  
  57.   { TForm1 }
  58.  
  59.   TForm1 = class(TForm)
  60.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  61.     playsound1: Tplaysound;
  62.     Timer1: TTimer;
  63.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  64.     procedure FormCreate(Sender: TObject);
  65.     procedure FormDestroy(Sender: TObject);
  66.     procedure Timer1Timer(Sender: TObject);
  67.   private
  68.  
  69.   public
  70.  
  71.   end;
  72.  
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79. {$R *.lfm}
  80.  
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. begin
  84.  // playsound1.Execute;        // play once when form created !
  85.   CharImage := TBGRABitmap.Create('font2x.png');
  86.   CharImage.SetSize(30,2226);
  87.   j:=0;
  88.   pause := 0;
  89. end;
  90.  
  91. procedure HexToRGB(hex: string; var r, g, b: Byte);
  92. begin
  93.   r := StrToInt('$' + Copy(hex, 2, 2));
  94.   g := StrToInt('$' + Copy(hex, 4, 2));
  95.   b := StrToInt('$' + Copy(hex, 6, 2));
  96. end;
  97.  
  98. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  99. var
  100.    I,   Chr: Integer;
  101.    CharX, CharY: Integer;
  102.    ScrollOffset: Integer;
  103.  
  104. begin
  105.   Bitmap.Fill(BGRAPixelTransparent);
  106.  
  107.   // raster bars cycle colors
  108.   for i := 0 to 20 do
  109.   begin
  110.        hexColor := cop_col[i+j];
  111.        HexToRGB(hexColor, red, green, blue);
  112.        Bitmap.FillRect(0,242+i*2,640,242+i*2-2,RGBToColor(red,green,blue));
  113.  
  114.   end;
  115.  
  116.      inc(pause);
  117.    if (pause>=1) then
  118.    begin
  119.        inc(j);
  120.        pause := 0;
  121.        if(j>=184) then j:=0;
  122.  
  123.     end;
  124.  
  125.   // Bitmap Scrolling  copy bitmap char with correct ascii code ,  x,y,x1,y1 like Amiga blitter
  126.   ScrollOffset :=  ScrollCounter ;
  127.   for I := 0 to 24 do
  128.     begin
  129.        Chr   := Ord(ScrollText[I]);
  130.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
  131.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  132.        Bitmap.PutImagePart(CharX , 240+CharY , CharImage, Rect(0, ascii[Chr-32]*CharHeight , CharW, ascii[Chr-32]*CharHeight+CharHeight), dmDrawWithTransparency);
  133.  
  134.   end;
  135.  
  136.   ScrollCounter := ScrollCounter + ScrollSpeed;
  137.  
  138.   if ScrollCounter >= CharWidth then
  139.      begin
  140.             ScrollCounter := ScrollCounter - CharWidth;
  141.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
  142.      end;
  143.  
  144.  // play sound every xxx sec
  145.  // inc(snd_timer);
  146.  //  if(snd_timer>500) then
  147.  // begin
  148.  //     snd_timer :=0;
  149.  //     playsound1.Execute;
  150.  
  151.  //  end
  152.  
  153. end;
  154.  
  155. procedure TForm1.Timer1Timer(Sender: TObject);
  156. begin
  157.       BGRAVirtualScreen1.RedrawBitmap;
  158.  
  159. end;
  160.  
  161. procedure TForm1.FormDestroy(Sender: TObject);
  162. // libere tout !!
  163. begin
  164.    //playsound1.Free;
  165.    CharImage.Free;
  166.  
  167. end;
  168.  
  169. end.
  170.  
26
Operating Systems / Re: Unlocking Files
« Last post by 440bx on Today at 05:51:27 pm »
@Redenegue,

It would be nice of you to put your code between code tags so it looks like this:
Code: Pascal  [Select][+][-]
  1. program ProgramName;

To see how I did that, click the "quote" (to quote the message) and you'll see the necessary tags between [ and ].

HTH.
27
Suggestions / Re: add new targets to make
« Last post by nickysn on Today at 05:50:18 pm »
Did you add your target to the [target] section of rtl/Makefile.fpc? Did you regenerate the Makefile after that?
28
General / Re: Compile/Convert Delphi project to MacOS
« Last post by Martin_fr on Today at 05:43:11 pm »
Quote from: Joseph on Today at 05:23:15 pm
Should I manually add Interfaces?

Its worth a try. And check that "Application" is "Run" as in my example, and the form is created.

Also "{$APPTYPE CONSOLE}" seems wrong (but may still work).  Well => that is, your app has forms?

Mind, that my answer is partly guessed... I mainly work on other parts of Lazarus...
29
General / Re: Generics - correct syntax
« Last post by Thaddy on Today at 05:40:59 pm »
Did you actually read the documentation? Because the differences are well documented.
I smell a bit of too lazy to read...
It is chapter 8 of the language reference guide... >:D

If there's anything not clear, report back. Otherwise disappear in a corner of shame.
You can come out of the corner if Michael says so.... :D ;D :o
30
Operating Systems / Re: Unlocking Files
« Last post by Redenegue on Today at 05:35:46 pm »
I have used 2 methods of renaming.
Usually they work good.
However sometimes when I go down a list of files, one or more of them will not rename.
I open Windows explorer, make a little change in the filename, and then my program will rename them.
So, it is in a list of files.
This happens in a situation where I never opened them.
But if I did accidentally open them, only a rare file, in a list, is affected, none of the others.
I am also curious why my function at the bottom will not rename files with foreign characters.
I thought it might work better than FileRename.
If they seem a little "wordy", its to make them easier to debug.
Also, there is no problem with the new file names. I checked that out carefully.
My renamed files get rid of questionable and junk characters, simplifies the name and gives them some common structure.

BTW, You have been kind to me. I appreciate that. I am old now, sometimes things get past me.
I have a few things to finish up while I can. I miss the old days when a hacker was a good guy.
Thank the ignorant media for that one. It was Phreakers who did the bad "hacking".
They never said a word about them. They turned a whole generation of us into criminals.

// Rename 1
TShellTreeView OnChange:
ActiveDir := IncludeTrailingPathDelimiter(STV1.Path); 

OnClickEvent:
     For I := 0 to ActiveList.Items.Count - 1 do
     begin
          If ActiveList.Items.Item.Selected then
          begin
               FN := ActiveList.Items.Item.Caption;
               NFN := FN;

// File Name altered here

               RenameFile(ActiveDir + FN, ActiveDir + NFN);
          end;
     end;

// Rename2
     I := 0;
     While I < Selected.FileList.Items.Count do
     begin
          If Selected.FileList.Items.Item.Selected then
          begin
               C := Selected.FileList.Items.Item.Caption;
               If MoveAFile(FileIn, FileOut) then
               Selected.FileList.Items.Item.Caption := C;

// This function will not rename files with foreign characters
Function TWork.MoveAFile(StrFrom, StrTo: string): Boolean;
var
  F : TShFileOpStruct;
begin
  F.wFunc:=FO_MOVE;
  F.pFrom:=PChar(StrFrom+#0);
  F.pTo:=PChar(StrTo+#0);
  F.fFlags := FOF_RENAMEONCOLLISION or FOF_NOCONFIRMMKDIR or FOF_NOCONFIRMATION or FOF_SILENT;

  if ShFileOperation(F) <> 0 then
    result:=False
  else
    result:=True;
end;               



Pages: 1 2 [3] 4 5 ... 10

TinyPortal © 2005-2018