+ Added (custom) cursors example from Paul Ishenin

git-svn-id: trunk@10666 -
2025-08-25 16:19:16 +02:00 · 2007-02-20 23:39:04 +00:00 · 2007-02-20 23:39:04 +00:00 · 1b0b818700
commit 1b0b818700
parent e8a85989c6
8 changed files with 389 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -1080,6 +1080,12 @@ examples/componentstreaming/componentstreaming.lpr svneol=native#text/plain
 examples/componentstreaming/mainunit.lfm svneol=native#text/plain
 examples/componentstreaming/mainunit.lrs svneol=native#text/plain
 examples/componentstreaming/mainunit.pas svneol=native#text/plain
+examples/cursors/car.cur -text svneol=unset#image/x-cursor
+examples/cursors/car.lrs svneol=native#text/pascal
+examples/cursors/project1.lpi svneol=native#text/plain
+examples/cursors/project1.lpr svneol=native#text/pascal
+examples/cursors/unit1.lrs -text svneol=unset#text/pascal
+examples/cursors/unit1.pas svneol=native#text/pascal
 examples/designerbaseclass/README.txt svneol=native#text/plain
 examples/designerbaseclass/customcomponentclass.pas svneol=native#text/plain
 examples/designerbaseclass/designbaseclassdemopkg.lpk svneol=native#text/plain
--- a/examples/cursors/car.cur
+++ b/examples/cursors/car.cur
--- a/examples/cursors/car.lrs
+++ b/examples/cursors/car.lrs
@ -0,0 +1,28 @@
+LazarusResources.Add('car','CUR',[
+  #0#0#2#0#1#0'  '#0#0#16#0#16#0#232#2#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1
+  +#0#4#0#0#0#0#0#0#2#0#0#0#0#0#0#0#0#0#0#16#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0
+  +#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192
+  +#192#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
+  +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#8#0#0#0
+  +#0#0#0#9#153#144#153#153#144#153#0#0#128#0#0#0#0#0#0#9#153#153#152#153#137
+  +#153#144#0#0#0#0#0#0#0#0#0#153#153#152#153#137#153#144#0#0#0#0#0#0#0#0#0#0
+  +#156#204#140#200#204#144#0#0#0#0#0#0#0#0#0#0#9#204#140#200#201#0#0#0#0#0#0#0
+  +#0#0#0#0#0#153#153#153#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#176#0#0#0#0#0#0#0#0#0#0#0#0
+  +#0#11#0#11#0#11#0#0#0#0#0#0#0#0#0#0#0#0#176#0#11#0#0#0#0#0#0#0#0#0#0#0#0#176
+  +#0#187#0#0#0#0#0#0#0#0#0#0#0#0#0#11#11#187#176#176#176#0#0#0#0#0#0#0#0#0#0#0
+  +#11#187#176#0#0#0#0#0#0#0#0#0#0#0#11#176#0#187#0#176#0#0#0#0#0#0#0#0#0#0#0#0
+  +#176#0#0#11#0#0#0#0#0#0#0#0#0#0#0#11#0#176#176#0#0#0#0#0#0#0#0#0#0#0#0#0#0
+  +#176#11#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+  +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
+  +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#254#251#247#255#252
+  +'q+'#255#224#0'w'#255#224#0''#255#240#0''#255#252#0''#255#254#0#255#255
+  +#255#1#255#255#255#255#255#255#255#255#255#255#255#255#223#255#255#254#238
+  +#255#255#255'{'#255#255#253#207#255#255#254#133''#255#255#135#255#255#249
+  +#205#255#255#255'~'#255#255#254#215#255#255#255#219#255
+]);
--- a/examples/cursors/project1.lpi
+++ b/examples/cursors/project1.lpi
@ -0,0 +1,105 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value=".\"/>
+      <TargetFileExt Value=".exe"/>
+      <Title Value="Test cursors"/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="project1"/>
+        <CursorPos X="3" Y="6"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="95"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="unit1.lrs"/>
+        <UnitName Value="Unit1"/>
+        <CursorPos X="13" Y="45"/>
+        <TopLine Value="39"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="95"/>
+        <Loaded Value="True"/>
+      </Unit1>
+    </Units>
+    <JumpHistory Count="1" HistoryIndex="0">
+      <Position1>
+        <Filename Value="project1.lpr"/>
+        <Caret Line="15" Column="15" TopLine="1"/>
+      </Position1>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+        <UseLineInfoUnit Value="False"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="LineBuf"/>
+        <Enabled Value="False"/>
+      </Item1>
+    </Watches>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/examples/cursors/project1.lpr
+++ b/examples/cursors/project1.lpr
@ -0,0 +1,15 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Interfaces, // this includes the LCL widgetset
+  Forms, Unit1;
+
+begin
+  Application.Title:='Test cursors';
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/examples/cursors/unit1.lfm
+++ b/examples/cursors/unit1.lfm
@ -0,0 +1,118 @@
+object Form1: TForm1
+  Left = 412
+  Height = 255
+  Top = 299
+  Width = 297
+  HorzScrollBar.Page = 296
+  VertScrollBar.Page = 254
+  ActiveControl = Button1
+  BorderIcons = [biSystemMenu, biMinimize]
+  BorderStyle = bsToolWindow
+  Caption = 'Cursor test'
+  OnCreate = FormCreate
+  object Label1: TLabel
+    Cursor = crHelp
+    Left = 16
+    Height = 13
+    Top = 7
+    Width = 157
+    Caption = 'Move mouse at this buttons:'
+    Color = clNone
+    ParentColor = False
+  end
+  object Bevel1: TBevel
+    Left = 8
+    Height = 3
+    Top = 136
+    Width = 279
+  end
+  object Label2: TLabel
+    Cursor = crHelp
+    Left = 16
+    Height = 13
+    Top = 144
+    Width = 209
+    Caption = 'Drag cursor test: drag buttons into list'
+    Color = clNone
+    ParentColor = False
+  end
+  object Button1: TButton
+    Cursor = crNoDrop
+    Left = 16
+    Height = 25
+    Top = 32
+    Width = 75
+    BorderSpacing.InnerBorder = 4
+    Caption = 'crNoDrop'
+    TabOrder = 0
+  end
+  object Button2: TButton
+    Cursor = crDrag
+    Left = 16
+    Height = 25
+    Top = 64
+    Width = 75
+    BorderSpacing.InnerBorder = 4
+    Caption = 'crDrag'
+    TabOrder = 1
+  end
+  object Button3: TButton
+    Cursor = crSQLWait
+    Left = 16
+    Height = 25
+    Top = 96
+    Width = 75
+    BorderSpacing.InnerBorder = 4
+    Caption = 'crSQLWait'
+    TabOrder = 2
+  end
+  object Panel1: TPanel
+    Left = 167
+    Height = 72
+    Top = 168
+    Width = 122
+    Caption = 'Drag here'
+    Color = clWhite
+    ParentColor = False
+    TabOrder = 3
+    OnDragDrop = Panel1DragDrop
+    OnDragOver = Panel1DragOver
+  end
+  object Panel2: TPanel
+    Left = 9
+    Height = 21
+    Top = 184
+    Width = 145
+    Caption = 'Can be accepted'
+    DragMode = dmAutomatic
+    TabOrder = 4
+  end
+  object Panel3: TPanel
+    Left = 9
+    Height = 21
+    Top = 213
+    Width = 145
+    Caption = 'Can not be accepted'
+    DragMode = dmAutomatic
+    TabOrder = 5
+  end
+  object Button4: TButton
+    Left = 155
+    Height = 25
+    Top = 96
+    Width = 132
+    BorderSpacing.InnerBorder = 4
+    Caption = 'Set Screen.Cursor'
+    OnClick = Button4Click
+    TabOrder = 6
+  end
+  object Button5: TButton
+    Left = 155
+    Height = 25
+    Top = 32
+    Width = 132
+    BorderSpacing.InnerBorder = 4
+    Caption = 'Custom cursor'
+    TabOrder = 7
+  end
+end
--- a/examples/cursors/unit1.lrs
+++ b/examples/cursors/unit1.lrs
@ -0,0 +1,34 @@
+{ Ýòî - ôàéë ðåñóðñîâ, àâòîìàòè÷åñêè ñîçäàííûé lazarus }
+
+LazarusResources.Add('TForm1','FORMDATA',[
+  'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#156#1#6'Height'#3#255#0#3'Top'#3'+'#1#5'W'
+  +'idth'#3')'#1#18'HorzScrollBar.Page'#3'('#1#18'VertScrollBar.Page'#3#254#0#13
+  +'ActiveControl'#7#7'Button1'#11'BorderIcons'#11#12'biSystemMenu'#10'biMinimi'
+  +'ze'#0#11'BorderStyle'#7#12'bsToolWindow'#7'Caption'#6#11'Cursor test'#8'OnC'
+  +'reate'#7#10'FormCreate'#0#6'TLabel'#6'Label1'#6'Cursor'#7#6'crHelp'#4'Left'
+  +#2#16#6'Height'#2#13#3'Top'#2#7#5'Width'#3#157#0#7'Caption'#6#27'Move mouse '
+  +'at this buttons:'#5'Color'#7#6'clNone'#11'ParentColor'#8#0#0#6'TBevel'#6'Be'
+  +'vel1'#4'Left'#2#8#6'Height'#2#3#3'Top'#3#136#0#5'Width'#3#23#1#0#0#6'TLabel'
+  +#6'Label2'#6'Cursor'#7#6'crHelp'#4'Left'#2#16#6'Height'#2#13#3'Top'#3#144#0#5
+  +'Width'#3#209#0#7'Caption'#6'(Drag cursor test: drag buttons into list'#5'Co'
+  +'lor'#7#6'clNone'#11'ParentColor'#8#0#0#7'TButton'#7'Button1'#6'Cursor'#7#8
+  +'crNoDrop'#4'Left'#2#16#6'Height'#2#25#3'Top'#2' '#5'Width'#2'K'#25'BorderSp'
+  +'acing.InnerBorder'#2#4#7'Caption'#6#8'crNoDrop'#8'TabOrder'#2#0#0#0#7'TButt'
+  +'on'#7'Button2'#6'Cursor'#7#6'crDrag'#4'Left'#2#16#6'Height'#2#25#3'Top'#2'@'
+  +#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#6'crDrag'#8'Ta'
+  +'bOrder'#2#1#0#0#7'TButton'#7'Button3'#6'Cursor'#7#9'crSQLWait'#4'Left'#2#16
+  +#6'Height'#2#25#3'Top'#2'`'#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#4#7
+  +'Caption'#6#9'crSQLWait'#8'TabOrder'#2#2#0#0#6'TPanel'#6'Panel1'#4'Left'#3
+  +#167#0#6'Height'#2'H'#3'Top'#3#168#0#5'Width'#2'z'#7'Caption'#6#9'Drag here'
+  +#5'Color'#7#7'clWhite'#11'ParentColor'#8#8'TabOrder'#2#3#10'OnDragDrop'#7#14
+  +'Panel1DragDrop'#10'OnDragOver'#7#14'Panel1DragOver'#0#0#6'TPanel'#6'Panel2'
+  +#4'Left'#2#9#6'Height'#2#21#3'Top'#3#184#0#5'Width'#3#145#0#7'Caption'#6#15
+  +'Can be accepted'#8'DragMode'#7#11'dmAutomatic'#8'TabOrder'#2#4#0#0#6'TPanel'
+  +#6'Panel3'#4'Left'#2#9#6'Height'#2#21#3'Top'#3#213#0#5'Width'#3#145#0#7'Capt'
+  +'ion'#6#19'Can not be accepted'#8'DragMode'#7#11'dmAutomatic'#8'TabOrder'#2#5
+  +#0#0#7'TButton'#7'Button4'#4'Left'#3#155#0#6'Height'#2#25#3'Top'#2'`'#5'Widt'
+  +'h'#3#132#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#17'Set Screen.Cur'
+  +'sor'#7'OnClick'#7#12'Button4Click'#8'TabOrder'#2#6#0#0#7'TButton'#7'Button5'
+  +#4'Left'#3#155#0#6'Height'#2#25#3'Top'#2' '#5'Width'#3#132#0#25'BorderSpacin'
+  +'g.InnerBorder'#2#4#7'Caption'#6#13'Custom cursor'#8'TabOrder'#2#7#0#0#0
+]);
--- a/examples/cursors/unit1.pas
+++ b/examples/cursors/unit1.pas
@ -0,0 +1,83 @@
+unit Unit1; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  StdCtrls, ExtCtrls;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Bevel1: TBevel;
+    Button1: TButton;
+    Button2: TButton;
+    Button3: TButton;
+    Button4: TButton;
+    Button5: TButton;
+    Label1: TLabel;
+    Label2: TLabel;
+    Panel1: TPanel;
+    Panel2: TPanel;
+    Panel3: TPanel;
+    procedure Button4Click(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
+    procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
+      State: TDragState; var Accept: Boolean);
+  private
+  public
+  end;
+
+var
+  Form1: TForm1; 
+
+implementation
+
+{ TForm1 }
+
+procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer;
+  State: TDragState; var Accept: Boolean);
+var
+  Control: TControl;
+begin
+  if Source is TDragControlObject then
+    Control := TDragControlObject(Source).Control else
+    Control := TControl(Source);
+  Accept := Control = Panel2;
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Screen.Cursors[1] := LoadCursorFromLazarusResource('car');
+  Button5.Cursor := 1;
+end;
+
+procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer);
+begin
+  ShowMessage('drag accepted');
+end;
+
+procedure TForm1.Button4Click(Sender: TObject);
+begin
+  if Screen.Cursor = crHourGlass then
+  begin
+    Screen.Cursor := crDefault;
+    Button4.Caption := 'Set Screen.Cursor';
+  end else
+  begin
+    Screen.Cursor := crHourGlass;
+    Button4.Caption := 'Unset Screen.Cursor';
+  end;
+end;
+
+initialization
+  {$I unit1.lrs}
+  {$I car.lrs}
+
+end.
+