Restructure Part 3.

* Moved all the examples over from the prototype directory.
* Removed obsolete GFX examples.

1 files changed, 247 insertions, 0 deletions

diff --git a/examples/corelib/eventtest/eventtest.lpr b/examples/corelib/eventtest/eventtest.lpr
new file mode 100644
index 00000000..5ba36a09
--- /dev/null
+++ b/examples/corelib/eventtest/eventtest.lpr
@@ -0,0 +1,247 @@
+program eventtest;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, GFXBase, fpGFX, gfx_widget;
+  
+
+const
+  ButtonNames: array[TMouseButton] of PChar =
+    ('Left', 'Right', 'Middle');
+
+type
+
+  { TMainForm }
+
+  TMainForm = class(TfpgWindow)
+  private
+    FMoveEventCount: integer;
+    function    ShiftStateToStr(Shift: TShiftState): string;
+    function    MouseState(AShift: TShiftState; const AMousePos: TPoint): string;
+    procedure   MsgActivate(var msg: TfpgMessageRec); message FPGM_ACTIVATE;
+    procedure   MsgDeActivate(var msg: TfpgMessageRec); message FPGM_DEACTIVATE;
+    procedure   MsgClose(var msg: TfpgMessageRec); message FPGM_CLOSE;
+    procedure   MsgPaint(var msg: TfpgMessageRec); message FPGM_PAINT;
+    procedure   MsgResize(var msg: TfpgMessageRec); message FPGM_RESIZE;
+    procedure   MsgMove(var msg: TfpgMessageRec); message FPGM_MOVE;
+    procedure   MsgKeyChar(var msg: TfpgMessageRec); message FPGM_KEYCHAR;
+    procedure   MsgKeyPress(var msg: TfpgMessageRec); message FPGM_KEYPRESS;
+    procedure   MsgKeyRelease(var msg: TfpgMessageRec); message FPGM_KEYRELEASE;
+    procedure   MsgMouseDown(var msg: TfpgMessageRec); message FPGM_MOUSEDOWN;
+    procedure   MsgMouseUp(var msg: TfpgMessageRec); message FPGM_MOUSEUP;
+    procedure   MsgMouseMove(var msg: TfpgMessageRec); message FPGM_MOUSEMOVE;
+    procedure   MsgDoubleClick(var msg: TfpgMessageRec); message FPGM_DOUBLECLICK;
+    procedure   MsgMouseEnter(var msg: TfpgMessageRec); message FPGM_MOUSEENTER;
+    procedure   MsgMouseExit(var msg: TfpgMessageRec); message FPGM_MOUSEEXIT;
+    procedure   MsgScroll(var msg: TfpgMessageRec); message FPGM_SCROLL;
+  protected
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure   Show;
+  end;
+
+{ TMainForm }
+
+function TMainForm.ShiftStateToStr(Shift: TShiftState): string;
+begin
+  SetLength(Result, 0);
+  if ssShift in Shift then
+    Result := 'Shift ';
+  if ssAlt in Shift then
+    Result := Result + 'Alt ';
+  if ssCtrl in Shift then
+    Result := Result + 'Ctrl ';
+  if ssMeta in Shift then
+    Result := Result + 'Meta ';
+  if ssSuper in Shift then
+    Result := Result + 'Super ';
+  if ssHyper in Shift then
+    Result := Result + 'Hyper ';
+  if ssAltGr in Shift then
+    Result := Result + 'AltGr ';
+  if ssCaps in Shift then
+    Result := Result + 'Caps ';
+  if ssNum in Shift then
+    Result := Result + 'Num ';
+  if ssScroll in Shift then
+    Result := Result + 'Scroll ';
+  if ssLeft in Shift then
+    Result := Result + 'Left ';
+  if ssRight in Shift then
+    Result := Result + 'Right ';
+  if ssMiddle in Shift then
+    Result := Result + 'Middle ';
+  if ssDouble in Shift then
+    Result := Result + 'Double ';
+  if Length(Result) > 0 then
+    SetLength(Result, Length(Result) - 1);
+
+end;
+
+function TMainForm.MouseState(AShift: TShiftState; const AMousePos: TPoint): string;
+var
+  ShiftStateStr: String;
+begin
+  ShiftStateStr := ShiftStateToStr(AShift);
+  Result := '[X=' + IntToStr(AMousePos.x) + ' Y=' + IntToStr(AMousePos.y);
+  if Length(ShiftStateStr) > 0 then
+    Result := Result + ' ' + ShiftStateStr;
+  Result := Result + '] ';
+end;
+
+procedure TMainForm.MsgActivate(var msg: TfpgMessageRec);
+begin
+  Writeln('Window Activate message');
+end;
+
+procedure TMainForm.MsgDeActivate(var msg: TfpgMessageRec);
+begin
+  Writeln('Window is Deactivate message');
+end;
+
+procedure TMainForm.MsgClose(var msg: TfpgMessageRec);
+begin
+  Writeln('Window Close message');
+  Halt(0);
+end;
+
+procedure TMainForm.MsgPaint(var msg: TfpgMessageRec);
+var
+  h: integer;
+begin
+  Writeln('Paint message');
+  Canvas.BeginDraw;
+  h := Canvas.Font.Height;
+  Canvas.SetColor(clWhite);
+  Canvas.FillRectangle(0, 0, Width, Height);
+  Canvas.SetTextColor(clBlack);
+  Canvas.DrawString(0, 0, 'Event test');
+  Canvas.DrawString(0, h, 'Do something interactive (move mouse, press keys...)');
+  Canvas.DrawString(0, h*2, 'and watch the output on the console.');
+  Canvas.EndDraw;
+end;
+
+procedure TMainForm.MsgResize(var msg: TfpgMessageRec);
+begin
+  Writeln('Resize');
+  FWidth  := msg.Params.rect.Width;
+  FHeight := msg.Params.rect.Height;
+
+  WriteLn('Window has been resized. New width: ',
+    Width, ' x ', Height);
+//    '; new client width: ', ClientWidth, ' x ', ClientHeight);
+
+end;
+
+procedure TMainForm.MsgMove(var msg: TfpgMessageRec);
+begin
+  WriteLn('Window has been moved to ', Left, '/', Top);
+end;
+
+procedure TMainForm.MsgKeyChar(var msg: TfpgMessageRec);
+var
+  AKeyChar: Char;
+begin
+  Write('Character generated: ');
+  AKeyChar := msg.Params.keyboard.keychar;
+  if AKeyChar >= ' ' then
+    WriteLn('''', AKeyChar, '''')
+  else
+    WriteLn('#', Ord(AKeyChar));
+end;
+
+procedure TMainForm.MsgKeyPress(var msg: TfpgMessageRec);
+begin
+  WriteLn('[', ShiftStateToStr(msg.Params.keyboard.shiftstate), '] Key pressed: ',
+    KeycodeToText(msg.Params.keyboard.keycode, []));
+end;
+
+procedure TMainForm.MsgKeyRelease(var msg: TfpgMessageRec);
+begin
+  WriteLn('[', ShiftStateToStr(msg.Params.keyboard.shiftstate), '] Key released: ',
+    KeycodeToText(msg.Params.keyboard.keycode, []));
+end;
+
+procedure TMainForm.MsgMouseDown(var msg: TfpgMessageRec);
+begin
+  WriteLn(MouseState(msg.Params.mouse.shiftstate, Point(msg.Params.mouse.x, msg.Params.mouse.y)),
+    'Mouse button pressed: ', ' button=' + IntToStr(msg.Params.mouse.Buttons));
+//    ButtonNames[msg.Params.mouse.Buttons]);
+end;
+
+procedure TMainForm.MsgMouseUp(var msg: TfpgMessageRec);
+begin
+  WriteLn(MouseState(msg.Params.mouse.shiftstate, Point(msg.Params.mouse.x, msg.Params.mouse.y)),
+    'Mouse button released: ', ' button=' + IntToStr(msg.Params.mouse.Buttons));
+//    ButtonNames[msg.Params.mouse.Buttons]);
+end;
+
+procedure TMainForm.MsgMouseMove(var msg: TfpgMessageRec);
+begin
+  inc(FMoveEventCount);
+  // only report mouse moves every 10 messages - just to limit the output a bit
+  if (FMoveEventCount mod 10) = 0 then
+  begin
+    WriteLn(MouseState(msg.Params.mouse.shiftstate, Point(msg.Params.mouse.x, msg.Params.mouse.y)), 'Mouse moved');
+  end;
+end;
+
+procedure TMainForm.MsgDoubleClick(var msg: TfpgMessageRec);
+begin
+  Writeln('Mouse doubleclick');
+end;
+
+procedure TMainForm.MsgMouseEnter(var msg: TfpgMessageRec);
+begin
+  WriteLn(MouseState(msg.Params.mouse.shiftstate, Point(msg.Params.mouse.x, msg.Params.mouse.y)), 'Mouse entered window');
+end;
+
+procedure TMainForm.MsgMouseExit(var msg: TfpgMessageRec);
+begin
+  WriteLn('Mouse left window');
+end;
+
+procedure TMainForm.MsgScroll(var msg: TfpgMessageRec);
+var
+  delta: smallint;
+begin
+  delta := msg.Params.mouse.delta;
+  Writeln('Mouse scroll delta=' + IntToStr(delta) + ' button=' + IntToStr(msg.Params.mouse.Buttons));
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+  inherited Create(aowner);
+  FMoveEventCount := 0;
+  FWidth    := 400;
+  FHeight   := 100;
+  WindowAttributes := [waSizeable, waScreenCenterPos];
+end;
+
+procedure TMainForm.Show;
+begin
+  AllocateWindowHandle;
+  // We can't set a title if we don't have a window handle. So we do that here
+  // and not in the constructor.
+  SetWindowTitle('fpGFX event test');
+end;
+  
+  
+procedure MainProc;
+var
+  frm: TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  frm.Show;
+  fpgApplication.Run;
+end;
+
+begin
+  MainProc;
+end.
+