diff options
author | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 09:40:43 +0000 |
---|---|---|
committer | graemeg <graemeg@ae50a9b5-8222-0410-bf8d-8a13f76226bf> | 2007-07-23 09:40:43 +0000 |
commit | 652ba160012b1eda3a1f6dafb9311b0dcade476c (patch) | |
tree | 8abf8d7cc6246484c646b8160b8ab0179ac5b069 /examples/corelib/eventtest/eventtest.lpr | |
parent | 6bda2054c8dda9b98f9958c54fce9f27927642c5 (diff) | |
download | fpGUI-652ba160012b1eda3a1f6dafb9311b0dcade476c.tar.xz |
Restructure Part 3.
* Moved all the examples over from the prototype directory.
* Removed obsolete GFX examples.
Diffstat (limited to 'examples/corelib/eventtest/eventtest.lpr')
-rw-r--r-- | examples/corelib/eventtest/eventtest.lpr | 247 |
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. + |