Recent

Recent Posts

Pages: 1 ... 8 9 [10]
91
General / Re: Assign (textfile) not compiling - sometimes.
« Last post by bytebites on Today at 07:12:17 am »
Or use AssignFile and CloseFile procedures from the SysUtils.
92
Beginners / Re: Find child controls by name
« Last post by Handoko on Today at 04:17:05 am »
Done.

This demo below shows how to use FindChildControl as suggested by Josh and writing yourself a function for checking the existance of the control:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls, ExtCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     btnFind: TButton;
  16.     Button1: TButton;
  17.     CheckBox1: TCheckBox;
  18.     Edit1: TEdit;
  19.     lbeName: TLabeledEdit;
  20.     Memo1: TMemo;
  21.     Panel1: TPanel;
  22.     RadioButton1: TRadioButton;
  23.     Shape1: TShape;
  24.     procedure btnFindClick(Sender: TObject);
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.  
  30. implementation
  31.  
  32. function HasControl(Container: TWinControl; const aName: string): Boolean;
  33. var
  34.   S: string;
  35.   i: Integer;
  36. begin
  37.   Result := False;
  38.   S := aName.ToUpper;
  39.   for i := 0 to Container.ControlCount-1 do
  40.   begin
  41.     if S = Container.Controls[i].Name.ToUpper then
  42.     begin
  43.       Result := True;
  44.       Exit;
  45.     end;
  46.   end;
  47. end;
  48.  
  49. {$R *.lfm}
  50.  
  51. { TForm1 }
  52.  
  53. procedure TForm1.btnFindClick(Sender: TObject);
  54. var
  55.   C: TControl;
  56.   S: string;
  57. begin
  58.   case HasControl(Panel1, lbeName.Text) of
  59.     True:
  60.       begin
  61.         C := Panel1.FindChildControl(lbeName.Text);
  62.         S := lbeName.Text + ' is found in Panel1.' + LineEnding +
  63.              'Class: ' +  C.ClassName              + LineEnding +
  64.              'Left: ' +   C.Left.ToString          + LineEnding +
  65.              'Top: ' +    C.Top.ToString           + LineEnding +
  66.              'Width: ' +  C.Width.ToString         + LineEnding +
  67.              'Height: ' + C.Height.ToString        + LineEnding;
  68.         ShowMessage(S);
  69.       end;
  70.     False:
  71.       ShowMessage(lbeName.Text + ' cannot be found in Panel1.');
  72.   end;
  73. end;
  74.  
  75. end.
93
Graphics / Demoscene The Champs Cracktro
« Last post by Gigatron on Today at 02:26:07 am »
Hi , late at night i woul like to share one of my new project;

The champs cracktro made wit LP;

In the past i made it with gdscript with Godot ;

https://www.youtube.com/watch?v=8ePm_udSYV4

Code with LP : missing font ... but i am working ;

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes;
  11.  
  12. const
  13.   StarCount = 400;
  14.   MaxSpeed  = 3;
  15.  
  16. type
  17.   TStar = record        //  Stars
  18.     X, Y, Z: Double;
  19.     Speed:   Double;
  20.   end;
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     BGLVirtualScr: TBGLVirtualScreen;
  26.     Timer1: TTimer;
  27.     procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure FormShow(Sender: TObject);
  31.     procedure Timer1Timer(Sender: TObject);
  32.  
  33.     private
  34.  
  35.     Stars  : array of TStar;
  36.     a_logo, bg_copper      : IBGLTexture;
  37.     one,nine,eight,eight_2 : IBGLTexture;
  38.  
  39.     private
  40.  
  41.     const cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
  42.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
  43.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
  44.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
  45.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
  46.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
  47.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
  48.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
  49.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
  50.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
  51.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
  52.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
  53.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
  54.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
  55.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
  56.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
  57.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
  58.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
  59.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
  60.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
  61.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
  62.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
  63.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
  64.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
  65.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
  66.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
  67.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
  68.                                             '#000099','#000088','#000077');
  69.  
  70.   // Sin table Ripped by Gigatron Winuae Debugger; x first 255 , y after 256 to 512 !!
  71.   const sprite_dat : Array[0..511] of integer = (80,80,81,83,86,90,94,99,104,110,116,123,130,137,145,152,159,167,173,180,186,192,197,
  72.                                                  202,206,209,212,214,215,216,216,216,214,213,210,208,205,201,197,193,189,185,181,177,
  73.                                                  173,169,166,162,160,157,155,153,152,151,151,151,151,152,153,155,156,158,160,162,164,
  74.                                                  166,168,170,171,172,173,174,174,174,173,172,170,168,166,163,160,156,152,148,143,139,
  75.                                                  134,129,125,120,116,112,108,105,102,100,98,97,97,97,98,100,102,106,109,114,119,125,131,
  76.                                                  137,144,151,159,166,174,182,189,196,203,209,215,221,226,230,233,236,238,239,239,238,237,
  77.                                                  235,232,228,224,219,214,208,202,195,188,181,174,167,160,154,147,141,135,130,125,121,118,
  78.                                                  115,112,111,110,109,109,110,112,113,116,118,121,124,128,131,135,139,142,146,149,152,155,
  79.                                                  157,159,161,162,163,163,163,163,162,161,160,158,156,154,152,150,148,146,144,142,141,139,
  80.                                                  139,138,138,139,139,141,143,145,148,151,155,159,163,168,173,178,183,188,194,199,204,208,
  81.                                                  212,216,220,222,225,226,227,227,227,225,223,221,217,213,208,203,197,190,183,176,169,161,
  82.                                                  153,145,138,130,123,116,110,104,99,94,90,87,84,83,82,86,82,79,75,72,68,65,62,60,57,55,54,
  83.                                                  53,52,51,51,51,52,53,54,55,57,59,62,64,67,69,72,75,78,81,83,86,89,91,93,95,97,98,99,100,
  84.                                                  101,101,102,101,101,101,100,99,98,97,96,95,94,92,91,90,89,88,87,87,86,86,86,86,86,87,88,
  85.                                                  88,89,90,92,93,94,96,97,99,100,101,102,103,104,105,105,105,105,105,104,103,102,100,98,96,
  86.                                                  94,92,89,86,83,80,77,74,71,68,65,63,60,58,56,54,52,51,50,50,50,50,50,51,53,55,57,59,62,65,
  87.                                                  68,71,75,78,82,86,89,93,97,100,103,106,109,111,114,115,117,118,119,119,119,119,119,118,116,
  88.                                                  115,113,111,109,107,104,102,99,96,94,91,89,86,84,82,80,79,77,76,75,75,74,74,74,75,75,76,76,
  89.                                                  77,78,79,80,81,82,83,84,85,86,87,87,87,87,87,87,86,86,85,84,82,81,80,78,76,75,73,72,70,69,67,
  90.                                                  66,65,65,64,64,64,64,65,66,67,68,70,72,74,77,80,83,86,89,92,95,98,102,105,108,111,113,116,118,
  91.                                                  120,121,122,123,124,124,123,123,121,120,118,116,114,111,108,105,101,98,94,91);
  92.  
  93.     procedure InitializeStarfield;
  94.     procedure UpdateStarfield;
  95.  
  96.   public
  97.  
  98.   end;
  99.  
  100. var
  101.   Form1: TForm1;
  102.  
  103.   hexColor: string;
  104.   red, green, blue: Byte;
  105.   pause : integer;
  106.   j: integer;
  107.  
  108.   // sprite  vars
  109.  
  110.   xx,yy,nx,ny,ex,ey,exx,eyy : integer;
  111.  
  112. implementation
  113.  
  114. {$R *.lfm}
  115.  
  116. { TForm1 }
  117.  
  118. procedure TForm1.FormCreate(Sender: TObject);
  119. begin
  120.   Randomize;
  121.   InitializeStarfield;
  122.   j:=0;
  123.   pause := 0;
  124.  // sprite var initialisation one,nine,eight * 2
  125.   xx :=0;
  126.   yy := 256;
  127.   nx := 6;
  128.   ny := 256+6;
  129.   ex := 12;
  130.   ey := 256+12;
  131.   exx:= 18;
  132.   eyy:= 256+18;
  133.  
  134.  
  135. end;
  136.  
  137. procedure TForm1.FormShow(Sender: TObject);
  138. begin
  139.         bg_copper := BGLTexture('bg_copper.png');
  140.         a_logo := BGLTexture('champs_logo.png');
  141.  
  142.         one     := BGLTexture('one.png');
  143.         nine    := BGLTexture('nine.png');
  144.         eight   := BGLTexture('eight.png');
  145.         eight_2 := BGLTexture('eight_2.png');
  146.  
  147.  
  148. end;
  149.  
  150. procedure TForm1.InitializeStarfield;
  151. var
  152.   i: Integer;
  153. begin
  154.   SetLength(Stars, StarCount); // Nombre d'étoiles
  155.   for i := 0 to High(Stars) do
  156.   begin
  157.     Stars[i].X := Random(ClientWidth);
  158.     Stars[i].Y := (60+Random(ClientHeight-140));
  159.     Stars[i].Speed := Random * 2 + 1; // Vitesse aléatoire
  160.   end;
  161. end;
  162.  
  163. procedure TForm1.UpdateStarfield;
  164. var
  165.   i : integer;
  166. begin
  167.   for i := 0 to High(Stars) do
  168.   begin
  169.      Stars[i].X := Stars[i].X + Stars[i].Speed*3 ;
  170.  
  171.     if Stars[i].X > ClientWidth then // Réinitialiser la position si l'étoile sort de l'écran
  172.     begin
  173.       Stars[i].X := 0;
  174.       Stars[i].Y := (60+Random(ClientHeight-140));
  175.       Stars[i].Speed := Random * 2 + 1;
  176.  
  177.     end;
  178.   end;
  179. end;
  180.  
  181. procedure HexToRGB(hex: string; var r, g, b: Byte);
  182. begin
  183.   r := StrToInt('$' + Copy(hex, 2, 2));
  184.   g := StrToInt('$' + Copy(hex, 4, 2));
  185.   b := StrToInt('$' + Copy(hex, 6, 2));
  186. end;
  187.  
  188.  
  189. procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  190. var
  191.   i : integer;
  192.   StarPosition: TPoint;
  193.   sttype : Int16 ;
  194.   col: TColor;
  195.  
  196. begin
  197.  
  198.  
  199.  
  200.     // draw logo and update Sf + 2 vertical raster bars
  201.   BGLCanvas.StretchPutImage(0,0,640,480, bg_copper);
  202.   // stars
  203.   for i := 0 to High(Stars) do
  204.   begin
  205.  
  206.     StarPosition.X := Round(Stars[i].X );
  207.     StarPosition.Y := Round(Stars[i].Y);
  208.     sttype := Round(Stars[i].Speed);
  209.  
  210.     col := RGBToColor(50,50,50);
  211.     // stars bitplanes colors
  212.     case  (sttype)  of
  213.       1: col := RGBToColor(50,50,50);
  214.       2: col := RGBToColor(238,238,238);
  215.       3: col := RGBToColor(100,136,255);
  216.       4: col := RGBToColor(125,125,125);
  217.       5: col := RGBToColor(150,150,150);
  218.       6: col := RGBToColor(175,175,175);
  219.       7: col := RGBToColor(200,200,200);
  220.       8: col := RGBToColor(254,254,254);
  221.  
  222.     end;
  223.       BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);
  224.   end;
  225.  
  226.   // raster bars cycle colors with pause like A-Team intro
  227.   for i := 0 to 31 do
  228.   begin
  229.        hexColor := cop_col[i+j];
  230.        HexToRGB(hexColor, red, green, blue);
  231.        BGLContext.Canvas.FillRect(0,370+i*2,640,370+i*2-4,RGBToColor(red,green,blue));
  232.  
  233.   end;
  234.  
  235.   inc(pause);
  236.    if (pause>=3) then
  237.    begin
  238.        inc(j);
  239.        pause := 0;
  240.        if(j>=184) then j:=0;
  241.  
  242.     end;
  243.  
  244.   BGLCanvas.PutImage(0,50,a_logo,255);    // champs 1988
  245.  
  246.   // sprites
  247.  
  248.   // sin table ...
  249.  
  250.    BGLCanvas.StretchPutImage(-30+sprite_dat[xx]*2 ,-20+sprite_dat[yy]*2,32,32,eight);
  251.    BGLCanvas.StretchPutImage(-30+sprite_dat[nx]*2 ,-20+sprite_dat[ny]*2,32,32,eight);
  252.    BGLCanvas.StretchPutImage(-30+sprite_dat[ex]*2 ,-20+sprite_dat[ey]*2,32,32,nine);
  253.    BGLCanvas.StretchPutImage(-30+sprite_dat[exx]*2 ,-20+sprite_dat[eyy]*2,32,32,one);
  254.  
  255.  
  256.    BGLCanvas.StretchPutImage(-10+sprite_dat[xx]*2 ,322,32,32,eight);
  257.    BGLCanvas.StretchPutImage(-10+sprite_dat[nx]*2 ,322,32,32,eight);
  258.    BGLCanvas.StretchPutImage(-10+sprite_dat[ex]*2 ,322,32,32,nine);
  259.    BGLCanvas.StretchPutImage(-10+sprite_dat[exx]*2 ,322,32,32,one);
  260.  
  261.    // limites les boucles
  262.  
  263.  
  264.     inc(exx);
  265.     inc(eyy);
  266.     if(exx>=255) then exx :=0;
  267.     if(eyy>=511) then eyy :=256;
  268.  
  269.     inc(ex);
  270.     inc(ey);
  271.     if(ex>=255) then ex :=0;
  272.     if(ey>=511) then ey :=256;
  273.  
  274.     inc(nx);
  275.     inc(ny);
  276.     if(nx>=255) then nx :=0;
  277.     if(ny>=511) then ny :=256;
  278.  
  279.     inc(xx);
  280.     inc(yy);
  281.     if(xx>=255) then xx :=0;
  282.     if(yy>=511) then yy :=256;
  283.  
  284.  
  285.   UpdateStarfield;
  286.  
  287.  
  288.  
  289. end;
  290.  
  291. procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);
  292. begin
  293.  
  294.   bg_copper := nil;
  295.   a_logo    := nil;
  296.  
  297.   one       := nil;
  298.   nine      := nil;
  299.   eight     := nil;
  300.   eight_2   := nil;
  301.  
  302. end;
  303.  
  304.  
  305.  
  306. procedure TForm1.Timer1Timer(Sender: TObject);
  307. begin
  308.  
  309.   BGLVirtualScr.Repaint;
  310. end;
  311.  
  312. end.




94
General / Re: Linux Workspaces -- StayOnTop?
« Last post by dbannon on Today at 02:13:13 am »
In my App, I use a system tray icon that the user can use to "call" any open windows to what ever workspace is currently open.

I mention this because with the recent adoption of Wayland many of the X11 things we take fro granted are disappearing so, if you do find a solution that does what you want, make sure it works under wayland before you build it into your app.

Davo
95
Beginners / Re: Find child controls by name
« Last post by Joanna on Today at 02:03:50 am »
Quote
function FindControl(Handle: HWND): TWinControl;
C:\lazarus\lcl\controls.pp(2705,10)
Description
Return the TWinControl of the given Handle.
The result is very interface specific. Use FindOwnerControl when Handle may be a non-TWinControl handle.
im not sure how to use handle for a name
96
General / Re: Assign (textfile) not compiling - sometimes.
« Last post by teresa on Today at 01:56:13 am »
Thanks TRon - the code is  indeed in a button click event.

Good to be reminded!
97
General / Re: Assign (textfile) not compiling - sometimes.
« Last post by TRon on Today at 01:48:13 am »
replace
Quote from: teresa on Today at 01:44:26 am
Code: Pascal  [Select][+][-]
  1.    {$IFDEF debug}
  2.    assign(debugfile, 'overfs.debug'); // problem here
  3.    rewrite(debugfile);
  4.    {$ENDIF}
with
Code: Pascal  [Select][+][-]
  1.    {$IFDEF debug}
  2.    system.assign(debugfile, 'overfs.debug'); // problem here
  3.    rewrite(debugfile);
  4.    {$ENDIF}
Probably better to prefix all system related routines, just in case.

The issue is that the code is probably situated somewhere in a control/component/form and there (in that scope) assign means something else.
98
General / Assign (textfile) not compiling - sometimes.
« Last post by teresa on Today at 01:44:26 am »
Is there a bug in text file handling?  FPC 3.2.2, Lazarus 3.2 - recently updated.

I have a few hundred lines of code. In the global variables there is
Code: Pascal  [Select][+][-]
  1.    {$DEFINE debug}
  2.  
  3.    {$IFDEF debug}
  4.    debugfile: Text;
  5.    {$ENDIF}
and later:
Code: Pascal  [Select][+][-]
  1.    {$IFDEF debug}
  2.    assign(debugfile, 'overfs.debug'); // problem here
  3.    rewrite(debugfile);
  4.    {$ENDIF}
(I'm doing it this way because I need to collect a whole lot of data - more than I want to see in the debugger.)
   
The editor is perfectly happy to suggest completions for the assign - for example suggesting Assign(out t: text; const c: shortstring);

But the compiler has other ideas:
   
Code: Pascal  [Select][+][-]
  1. unit1.pp(343,36) Error: (3026) Wrong number of parameters specified for call to "Assign"
  2. /usr/local/lib/fpc/3.2.2/units/x86_64-linux/rtl/classes.ppu:persist.inc(104,23) Error: (5088) Found declaration: Assign(TPersistent);

(That declaration is the first in the list offered by the code editor. but not the one for today.)

I have worked around this issue with a stringlist, but what is happening? Enquiring minds etc.
99
General / Re: How to: create DLL file for Windows 10 64-Bit Pro
« Last post by KodeZwerg on Today at 12:57:56 am »
Here is my working testcode, no units included.
Code: Pascal  [Select][+][-]
  1. program project1;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. type
  6.   LPCSTR = PAnsiChar;
  7.   DWORD = Cardinal;
  8.   ULONG_PTR = UInt64;
  9.   LongBool = False..Boolean(4294967295);
  10.   BOOL = LongBool;
  11.   THandle = {$IFDEF WIN32} Cardinal {$ENDIF} {$IFDEF WIN64} UInt64 {$ENDIF};
  12.   POverlapped = ^TOverlapped;
  13.   _OVERLAPPED = record
  14.     Internal: ULONG_PTR;
  15.     InternalHigh: ULONG_PTR;
  16.     Offset: DWORD;
  17.     OffsetHigh: DWORD;
  18.     hEvent: THandle;
  19.   end;
  20.   TOverlapped = _OVERLAPPED;
  21.   PSecurityAttributes = ^TSecurityAttributes;
  22.   _SECURITY_ATTRIBUTES = record
  23.     nLength: DWORD;
  24.     lpSecurityDescriptor: Pointer;
  25.     bInheritHandle: BOOL;
  26.   end;
  27.   TSecurityAttributes = _SECURITY_ATTRIBUTES;
  28.  
  29. const
  30.   GENERIC_WRITE = $40000000;
  31.   FILE_SHARE_READ = $00000001;
  32.   FILE_SHARE_WRITE = $00000002;
  33.   CREATE_NEW = 1;
  34.   OPEN_EXISTING = 3;
  35.   FILE_END = 2;
  36.   FILE_ATTRIBUTE_NORMAL = $00000080;
  37.   INVALID_HANDLE_VALUE = THandle(-1);
  38.  
  39. function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; stdcall; external 'kernel32.dll' name 'WriteFile';
  40. function CreateFileA(lpFileName: LPCSTR; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: PSecurityAttributes; dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle; stdcall; external 'kernel32.dll' name 'CreateFileA';
  41. function SetFilePointer(hFile: THandle; lDistanceToMove: Longint; lpDistanceToMoveHigh: Pointer; dwMoveMethod: DWORD): DWORD; stdcall; external 'kernel32.dll' name 'SetFilePointer';
  42. function CloseHandle(hObject: THandle): BOOL; stdcall; external 'kernel32.dll' name 'CloseHandle';
  43.  
  44. procedure AppendToFile(const AFileName: string; AData: PAnsiChar);
  45. var
  46.   hFile: THandle;
  47.   cnt: Cardinal;
  48.   DataSize: Integer;
  49. begin
  50.   DataSize := StrLen(AData);
  51.   hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
  52.              OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  53.   if (hFile = INVALID_HANDLE_VALUE) then
  54.       hFile := CreateFileA(PAnsiChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
  55.                  CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
  56.   if (hFile <> INVALID_HANDLE_VALUE) then
  57.     begin
  58.       SetFilePointer(hFile, 0, nil, FILE_END);
  59.       WriteFile(hFile, AData^, DataSize, cnt, nil);
  60.       CloseHandle(hFile);
  61.     end;
  62. end;
  63.  
  64. begin
  65.   AppendToFile('test.txt', 'Hello World.');
  66.   ReadLn;
  67. end.
100
General / Re: Slow copying of small structures
« Last post by jamie on Today at 12:37:04 am »
It takes a few steps to setup a REP mov like that. You need to load the xSI, xDI, xCX  and initate the REP  xmov

Those steps alone most likely take more than a simple two steps of moving an 8 byte value via registers.

 SO the slowness you are seeing on small objects is most likely due to the initial setup of that operation.
 
 of course, on larger fields, once setup, your savings of using the REP ... should show.

Maybe the compiler should take into account those steps and use a series of register moves that would equal the same time as the initial loading of a small chunk or less.


Pages: 1 ... 8 9 [10]

TinyPortal © 2005-2018