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; DoSetWindowVisible(True); // 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.