Recent

Recent Posts

Pages: [1] 2 3 ... 10
1
General / Re: Assign (textfile) not compiling - sometimes.
« Last post by dsiders on Today at 08:51:13 am »
Quote from: MarkMLl on Today at 08:18:31 am
Quote from: bytebites on Today at 07:12:17 am
Or use AssignFile and CloseFile procedures from the SysUtils.

Curiously, I don't see those indexed in the RTL documentation.

MarkMLl

None of the procedure or functions in objpas.pp are indexed or generated in the documentation. Probably because they're wrapped with $ifdefs that weren't defined when the docs were built. My guess.

[Edit]
And I just checked... they are present in the FPDoc xml file.
2
General / Re: Text orientation in TMemo?
« Last post by CM630 on Today at 08:41:53 am »
I reproduced it and found a solution that solves the dragging issue, it does not seem to affect the AxisClick behaviour.
A sample code is attached, with the same code, as shown below.
It is as you proposed. If ctMainAxisClick.Toolset:=ctMain; is before ctMainDataPointDrag.Toolset:=ctMain; I cannot drag,
but when I reversed the order of these two lines, I can drag.
But if you run the app, you might also notice, that Label2 changes its caption when clicking/dragging on places which are too far from the axises. Maybe this behaviour is not okay?

Code: Pascal  [Select][+][-]
  1.  
  2.   Chart1.Toolset := ctMain;
  3.   ctMainAxisClick.Toolset:=ctMain;
  4.   ctMainDataPointDrag.Toolset:=ctMain;  
  5.  




The full code of the snippet:
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6.  
  7. interface
  8.  
  9.  
  10. uses
  11.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, TAGraph,
  12.   TATools, TASeries, TADrawUtils, TACustomSeries, Types, TAChartAxis, TASources, TACustomSource,TAChartUtils;
  13.  
  14.  
  15. type
  16.  
  17.  
  18.   TFloatPoint = Record
  19.     X: Double;
  20.     Y: Double;
  21.   end;
  22.  
  23.  
  24.   TFloatPointArray = array of TFloatPoint;
  25.   { TForm1 }
  26.  
  27.  
  28.   TForm1 = class(TForm)
  29.     Chart1: TChart;
  30.     Chart1LineSeries1: TLineSeries;
  31.     Label1: TLabel;
  32.     Label2: TLabel;
  33.     Label3: TLabel;
  34.  
  35.  
  36.     ctMain: TChartToolset;
  37.     ctMainDataPointDrag: TDataPointDragTool;
  38.     ctMainAxisClick: TAxisClickTool;
  39.     procedure ctMainAxisClickToolOnClick(ASender: TChartTool; Axis: TChartAxis; AHitInfo: TChartAxisHitTests);
  40.     procedure ctMainDataPointDragAfterMouseMove(ATool: TChartTool; APoint: TPoint);
  41.     procedure ctMainDataPointDragTool1DragStart(ASender: TDataPointDragTool; var AGraphPoint: TDoublePoint);
  42.     procedure FormCreate(Sender: TObject);
  43.   private
  44.  
  45.  
  46.   public
  47.  
  48.  
  49.   end;
  50.  
  51.  
  52. var
  53.   Form1: TForm1;
  54.  
  55.  
  56. implementation
  57.  
  58.  
  59. {$R *.lfm}
  60.  
  61.  
  62. { TForm1 }
  63.  
  64.  
  65. function GenSin (Frequency: Extended; Amplitude: Extended; SamPerSec:single; Offset: Extended=0; Duration: integer= 1000;PhaseShift:single=0): TFloatPointArray;
  66. var
  67.   i: integer;
  68.   SampleCount: integer;
  69.   dt: double;
  70.   debY: double;
  71. begin
  72.   SampleCount:=trunc(SamPerSec*Duration/1000)+1;
  73.   SetLength(Result,SampleCount);
  74.   dt:=1/SamPerSec;
  75.   for i:= 0 to SampleCount-1 do
  76.   begin
  77.     Result[i].X:=i/SamPerSec ;
  78.     debY:=sin(i*2*pi*Frequency/SamPerSec+(PhaseShift*2*pi/360))*Amplitude+Offset;
  79.     Result[i].Y:=sin(i*2*pi*Frequency/SamPerSec+(PhaseShift*2*pi/360))*Amplitude+Offset;
  80.   end;
  81. end;
  82.  
  83.  
  84. procedure TForm1.FormCreate(Sender: TObject);
  85. var
  86.   LSeriesArray: array of TLineSeries;
  87.   i: integer;
  88.   sin1: TFloatPointArray;
  89. begin
  90.   ctMain:=TChartToolset.Create (Chart1);
  91.  
  92.  
  93.   ctMainAxisClick := TAxisClickTool.Create(ctMain);
  94.   ctMainAxisClick.Shift := [ssLeft];
  95.   ctMainAxisClick.Enabled := True;
  96.   ctMainAxisClick.OnClick := @ctMainAxisClickToolOnCLick;
  97.  
  98.  
  99.   ctMainDataPointDrag:=TDataPointDragTool.Create(ctMain);
  100.   ctMainDataPointDrag.Shift:=[ssLeft];
  101.   ctMainDataPointDrag.Enabled:=True;
  102.   ctMainDataPointDrag.OnDragStart := @ctMainDataPointDragTool1DragStart;
  103.   ctMainDataPointDrag.OnAfterMouseMove:=@ctMainDataPointDragAfterMouseMove;
  104.  
  105.  
  106.   Chart1.Toolset := ctMain;
  107.   ctMainAxisClick.Toolset:=ctMain;
  108.   ctMainDataPointDrag.Toolset:=ctMain;
  109.  
  110.  
  111.   sin1 := GenSin(50,5,1000,0,1000);
  112.   for i:=0 to Length(sin1) do
  113.     Chart1LineSeries1.AddXY(sin1[i].x,sin1[i].y);
  114.  
  115.  
  116.   SetLength (LSeriesArray ,10);
  117.   for i:=0 to 9 do
  118.   begin
  119.     LSeriesArray[i] := TLineSeries.Create(self);
  120.     Chart1.AddSeries(LSeriesArray[i]);
  121.     LSeriesArray[i].Pointer.Visible := true;
  122.     LSeriesArray[i].AddXY(i/10,i);
  123.   end;
  124. end;
  125.  
  126.  
  127. procedure TForm1.ctMainDataPointDragAfterMouseMove(ATool: TChartTool; APoint: TPoint);
  128. begin
  129.   if ctMainDataPointDrag.Series = nil then Label3.Caption := 'nil' else Label3.Caption := IntToStr( ctMainDataPointDrag.Series.Index);
  130.   Label1.Caption := {ChartToolset1DataPointDragTool1.Series.Name + '; ' +}  IntToStr(APoint.X) + '; ' + IntToStr(APoint.y)  ;
  131. end;
  132.  
  133.  
  134. procedure TForm1.ctMainAxisClickToolOnCLick(ASender: TChartTool; Axis: TChartAxis; AHitInfo: TChartAxisHitTests);
  135. begin
  136.   Label2.Caption := Axis.DisplayName;
  137. end;
  138.  
  139.  
  140. procedure TForm1.ctMainDataPointDragTool1DragStart(ASender: TDataPointDragTool; var AGraphPoint: TDoublePoint);
  141. begin
  142.   if ctMainDataPointDrag.Series = nil then exit; //Checks if a dot is dragger, to prevent crashing
  143.   if ctMainDataPointDrag.Series = Chart1LineSeries1 then       ASender.Handled;; //Prevent dragging the main curve
  144. end;
  145.  
  146.  
  147. end.
3
General / Re: Linux Workspaces -- StayOnTop?
« Last post by AmatCoder on Today at 08:21:27 am »
Quote
Hi, I need an app to stay visible on all workspaces.

Wayland  ->  You (as developer) can't force that.
X11  ->  You can force it but ultimately it depends on Window Manager (normally it works).

Quote
I know it is possible as the Linux App, "sticky" (yellow notes) does it.

GTK has a function for that (only works on X11): https://developer-old.gnome.org/gtk2/stable/GtkWindow.html#gtk-window-stick

As far as I remember, Qt has nothing similar.
4
General / Re: Assign (textfile) not compiling - sometimes.
« Last post by MarkMLl on Today at 08:18:31 am »
Quote from: bytebites on Today at 07:12:17 am
Or use AssignFile and CloseFile procedures from the SysUtils.

Curiously, I don't see those indexed in the RTL documentation.

MarkMLl
5
Graphics / Re: Demoscene The Champs Cracktro
« Last post by Lulu on Today at 08:15:12 am »
Well done!
This remember me the circuits Copper, Blitter in the Amiga500! (may be other ? I forgot)
6
General / Re: Linux Workspaces -- StayOnTop?
« Last post by MarkMLl on Today at 08:12:09 am »
Quote from: VisualLab on April 17, 2024, 11:25:09 pm
And it works in any windowed environment? Or maybe only in GNOME and KDE? I'm asking because Linux doesn't have a standard DE. Each of them works "in its own way".

I think it would be worth replacing "Linux" with "unix" there, and the situation with a Window Manager which might- or might not- be distinct from the overall desktop environment is highly variable.

In fact I believe that the whole idea of having multiple desktops is basically an MS Windows one, where originally they were implemented using the Windowstations layer which was added mainly to support Windows NT Terminal Server but then repurposed.

While unix introduced that sort of functionality with e.g. the fvwm Window Manager, X11 doesn't have an equivalent layer and so I believe has to emulate it by minimising/hiding and restoring each window. That makes "keep on top" etc. highly sensitive to hidden implementation details.

MarkMLl
7
Databases / Re: Azure sql database will not connect
« Last post by paweld on Today at 07:24:47 am »
Hi,
You need to install the previous version of msoledb: https://www.microsoft.com/en-us/download/details.aspx?id=56730
I misled a bit earlier, because the bitness of the driver is supposed to match the bitness of the operating system and not the application.
8
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.
9
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.
10
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.




Pages: [1] 2 3 ... 10

TinyPortal © 2005-2018