diff options
-rw-r--r-- | examples/gfx/helloworld/helloworld.lpi | 1 | ||||
-rw-r--r-- | examples/gfx/subwindow/subwindow.lpi | 1 | ||||
-rw-r--r-- | gfx/gdi/gfx_gdi.pas | 371 | ||||
-rw-r--r-- | gfx/gfxbase.pas | 35 |
4 files changed, 189 insertions, 219 deletions
diff --git a/examples/gfx/helloworld/helloworld.lpi b/examples/gfx/helloworld/helloworld.lpi index a05656dc..28e724e4 100644 --- a/examples/gfx/helloworld/helloworld.lpi +++ b/examples/gfx/helloworld/helloworld.lpi @@ -14,7 +14,6 @@ </General> <PublishOptions> <Version Value="2"/> - <DestinationDirectory Value="$(TestDir)\publishedproject\"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> </PublishOptions> diff --git a/examples/gfx/subwindow/subwindow.lpi b/examples/gfx/subwindow/subwindow.lpi index 3d6959f4..88f43f80 100644 --- a/examples/gfx/subwindow/subwindow.lpi +++ b/examples/gfx/subwindow/subwindow.lpi @@ -14,7 +14,6 @@ </VersionInfo> <PublishOptions> <Version Value="2"/> - <DestinationDirectory Value="$(TestDir)\publishedproject\"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> </PublishOptions> diff --git a/gfx/gdi/gfx_gdi.pas b/gfx/gdi/gfx_gdi.pas index fa285bdf..34179a40 100644 --- a/gfx/gdi/gfx_gdi.pas +++ b/gfx/gdi/gfx_gdi.pas @@ -186,8 +186,10 @@ type procedure UpdateWindowButtons; function DoMouseEnterLeaveCheck(uMsg, wParam, lParam: Cardinal): Boolean; public + { Constructors / Destructors } constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override; destructor Destroy; override; + { Widget controling methods } procedure SetPosition(const APosition: TPoint); override; procedure SetSize(const ASize: TSize); override; procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); override; @@ -198,7 +200,25 @@ type procedure PaintInvalidRegion; override; procedure CaptureMouse; override; procedure ReleaseMouse; override; - procedure ProcessEvent(AEvent: TFEvent); override; + { Event processing methods } +// procedure ProcessEvent(AEvent: TFEvent); override; + procedure EvCreate; override; + procedure EvFocusIn; override; + procedure EvFocusOut; override; + procedure EvHide; override; + procedure EvKeyPressed(AKey: Word); override; + procedure EvKeyReleased(AKey: Word); override; + procedure EvKeyChar(AKeyChar: Char); override; + procedure EvMouseEnter(const AMousePos: TPoint); override; + procedure EvMouseLeave; override; + procedure EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint); override; + procedure EvMouseReleased(AButton: TMouseButton; const AMousePos: TPoint); override; + procedure EvMouseMove(const AMousePos: TPoint); override; + procedure EvMouseWheel(AWheelDelta: Single; const AMousePos: TPoint); override; + procedure EvPaint; override; + procedure EvMove; override; + procedure EvResize; override; + procedure EvShow; override; end; @@ -1083,12 +1103,11 @@ function fpGFXWindowProc(hwnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var Window: TGDIWindow; - Event: TFEvent; PaintStruct: TPaintStruct; r: TRect; OldCanvas: TFCustomCanvas; begin - Event := TFEvent.Create; + Result := 0; if uMsg = WM_CREATE then begin @@ -1100,17 +1119,11 @@ begin if Assigned(Window) then begin - Event.msg := uMsg; - Event.wParam := wParam; - Event.lParam := lParam; - Event.Result := 0; - case uMsg of { Messages } WM_CREATE: begin - Event.EventType := etCreate; - Window.ProcessEvent(Event); + Window.EvCreate(); end; WM_DESTROY: begin @@ -1129,38 +1142,28 @@ begin end; WM_Activate: begin - if wParam = WA_INACTIVE then - begin - Event.EventType := etFocusOut; - Window.ProcessEvent(Event); - end - else - begin - Event.EventType := etFocusIn; - Window.ProcessEvent(Event); - end; + if wParam = WA_INACTIVE then Window.EvFocusOut() + else Window.EvFocusIn(); end; WM_Paint: begin - Event.EventType := etPaint; - Window.ProcessEvent(Event); + Windows.BeginPaint(Window.Handle, @PaintStruct); + Window.EvPaint(); + Windows.EndPaint(Window.Handle, @PaintStruct); end; WM_ShowWindow: begin if wParam <> 0 then begin - Event.EventType := etFocusIn; - Window.ProcessEvent(Event); + Window.EvFocusIn(); + + Window.EvShow(); - Event.EventType := etShow; - Window.ProcessEvent(Event); - GFApplication.AddWindow(Window); end else begin - Event.EventType := etHide; - Window.ProcessEvent(Event); + Window.EvHide(); GFApplication.RemoveWindow(Window); end; @@ -1172,8 +1175,7 @@ begin Window.FLeft := LoWord(lParam); Window.FTop := HiWord(lParam); - Event.EventType := etMove; - Window.ProcessEvent(Event); + Window.EvMove(); end; end; WM_Size: @@ -1188,8 +1190,7 @@ begin Window.FClientHeight := HiWord(lParam); TGDICanvas(Window.Canvas).Resized(Window.FWidth, Window.FHeight); - Event.EventType := etResize; - Window.ProcessEvent(Event); + Window.EvResize(); end; end; { Input messages } @@ -1200,18 +1201,16 @@ begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMousePressed; - Event.MouseButton := mbLeft; - Window.ProcessEvent(Event); + Window.EvMousePressed(mbLeft, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_LButtonUp: begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMouseReleased; - Event.MouseButton := mbLeft; - Window.ProcessEvent(Event); + Window.EvMouseReleased(mbLeft, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_RButtonDown: @@ -1221,18 +1220,16 @@ begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMousePressed; - Event.MouseButton := mbRight; - Window.ProcessEvent(Event); + Window.EvMousePressed(mbRight, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_RButtonUp: begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMouseReleased; - Event.MouseButton := mbRight; - Window.ProcessEvent(Event); + Window.EvMouseReleased(mbRight, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_MButtonDown: @@ -1242,63 +1239,58 @@ begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMousePressed; - Event.MouseButton := mbMiddle; - Window.ProcessEvent(Event); + Window.EvMousePressed(mbMiddle, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_MButtonUp: begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMouseReleased; - Event.MouseButton := mbMiddle; - Window.ProcessEvent(Event); + Window.EvMouseReleased(mbMiddle, + Point(LoWord(lparam), HiWord(lParam))); end; end; WM_MouseMove: begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMouseMove; - Window.ProcessEvent(Event); + Window.EvMouseMove(Point(LoWord(lParam), HiWord(lParam))); end; end; WM_MouseWheel: begin if Window.DoMouseEnterLeaveCheck(uMsg, wParam, lParam) then begin - Event.EventType := etMouseWheel; - Window.ProcessEvent(Event); +// Windows.ScreenToClient(Handle, @pt); + Window.EvMouseWheel( + SmallInt(HiWord(wParam)) / -120.0, + Point(LoWord(lparam), HiWord(lparam)) + ); end; end; WM_KeyDown, WM_SysKeyDown: begin - Event.EventType := etKeyPressed; - Window.ProcessEvent(Event); + Window.EvKeyPressed(VirtKeyToKeycode(wParam)); + + if (wParam = $2e {VK_DELETE}) then Window.EvKeyChar(#127); end; WM_KeyUp, WM_SysKeyUp: begin - Event.EventType := etKeyReleased; - Window.ProcessEvent(Event); + Window.EvKeyReleased(VirtKeyToKeycode(wParam)); end; WM_Char, WM_SysChar: begin - Event.EventType := etKeyChar; - Window.ProcessEvent(Event); + Window.EvKeyChar(Chr(wParam)); end; else if UnicodeEnabledOS then Result := Windows.DefWindowProcW(hwnd, uMsg, wParam, lParam) else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); end; - - if Result = 0 then Result := Event.Result; end else if UnicodeEnabledOS then Result := Windows.DefWindowProcW(hwnd, uMsg, wParam, lParam) else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam); - - Event.Free; end; @@ -1549,133 +1541,110 @@ begin end; end; -procedure TGDIWindow.ProcessEvent(AEvent: TFEvent); +procedure TGDIWindow.EvCreate; +begin + if Assigned(OnCreate) then OnCreate(Self); +end; + +procedure TGDIWindow.EvFocusIn; +begin + FHasFocus := True; + if Assigned(OnFocusIn) then OnFocusIn(Self); +end; + +procedure TGDIWindow.EvFocusOut; +begin + FHasFocus := False; + if Assigned(OnFocusOut) then OnFocusOut(Self); +end; + +procedure TGDIWindow.EvHide; +begin + if Assigned(OnHide) then OnHide(Self); +end; + +procedure TGDIWindow.EvKeyPressed(AKey: Word); +begin + if Assigned(OnKeyPressed) then OnKeyPressed(Self, AKey, GetKeyboardShiftState) + else if Assigned(Parent) then Parent.EvKeyPressed(AKey); +end; + +procedure TGDIWindow.EvKeyReleased(AKey: Word); +begin + if Assigned(OnKeyReleased) then OnKeyReleased(Self, AKey, GetKeyboardShiftState) + else if Assigned(Parent) then Parent.EvKeyReleased(AKey); +end; + +procedure TGDIWindow.EvKeyChar(AKeyChar: Char); +begin + if Assigned(OnKeyChar) then OnKeyChar(Self, AKeyChar) + else if Assigned(Parent) then Parent.EvKeyChar(AKeyChar); +end; + +procedure TGDIWindow.EvMouseEnter(const AMousePos: TPoint); +begin + if Assigned(OnMouseEnter) then + OnMouseEnter(Self, GetKeyboardShiftState, AMousePos) + else if Assigned(Parent) then Parent.EvMouseEnter(AMousePos); +end; + +procedure TGDIWindow.EvMouseLeave; +begin + if Assigned(OnMouseLeave) then OnMouseLeave(Self) + else if Assigned(Parent) then Parent.EvMouseLeave; +end; + +procedure TGDIWindow.EvMousePressed(AButton: TMouseButton; + const AMousePos: TPoint); +begin + if Assigned(OnMousePressed) then + OnMousePressed(Self, AButton, GetKeyboardShiftState, AMousePos) + else if Assigned(Parent) then Parent.EvMousePressed(AButton, AMousePos); +end; + +procedure TGDIWindow.EvMouseReleased(AButton: TMouseButton; + const AMousePos: TPoint); +begin + if Assigned(OnMouseReleased) then + OnMouseReleased(Self, AButton, GetKeyboardShiftState, AMousePos) + else if Assigned(Parent) then Parent.EvMouseReleased(AButton, AMousePos); +end; + +procedure TGDIWindow.EvMouseMove(const AMousePos: TPoint); +begin + if Assigned(OnMouseMove) then + OnMouseMove(Self, GetKeyboardShiftState, AMousePos) + else if Assigned(Parent) then Parent.EvMouseMove(AMousePos); +end; + +procedure TGDIWindow.EvMouseWheel(AWheelDelta: Single; const AMousePos: TPoint); +begin + if Assigned(OnMouseWheel) then + OnMouseWheel(Self, GetKeyboardShiftState, AWheelDelta, AMousePos) + else if Assigned(Parent) then Parent.EvMouseWheel(AWheelDelta, AMousePos); +end; + +procedure TGDIWindow.EvPaint; var - pt: Windows.POINT; - PaintStruct: TPaintStruct; - r: Windows.RECT; - OldCanvas: TFCustomCanvas; + r: TRect; begin - case AEvent.EventType of - etCreate: - begin - if Assigned(OnCreate) then OnCreate(Self) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etCanClose: - begin - end; - etClose: - begin - end; - etFocusIn: - begin - FHasFocus := True; - if Assigned(OnFocusIn) then OnFocusIn(Self); - end; - etFocusOut: - begin - FHasFocus := False; - if Assigned(OnFocusOut) then OnFocusOut(Self); - end; - etHide: - begin - if Assigned(OnHide) then OnHide(Self); - end; - etKeyPressed: - begin - if Assigned(OnKeyPressed) then OnKeyPressed(Self, VirtKeyToKeycode(AEvent.wParam), GetKeyboardShiftState) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); + if Assigned(OnPaint) then + OnPaint(Self, r); +end; - if (AEvent.wParam = $2e {VK_DELETE}) then - begin - if Assigned(OnKeyChar) then OnKeyChar(Self, #127) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - end; - etKeyReleased: - begin - if Assigned(OnKeyReleased) then OnKeyReleased(Self, VirtKeyToKeycode(AEvent.wParam), GetKeyboardShiftState) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etKeyChar: - begin - if Assigned(OnKeyChar) then OnKeyChar(Self, Chr(AEvent.wParam)) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMouseEnter: - begin - if Assigned(OnMouseEnter) then - OnMouseEnter(Self, GetKeyboardShiftState, Point(LoWord(AEvent.lParam), HiWord(AEvent.lParam))) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMouseLeave: - begin - if Assigned(OnMouseLeave) then OnMouseLeave(Self) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMousePressed: - begin - if Assigned(OnMousePressed) then - OnMousePressed(Self, AEvent.MouseButton, GetKeyboardShiftState, Point(LoWord(AEvent.lparam), HiWord(AEvent.lParam))) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMouseReleased: - begin - if Assigned(OnMouseReleased) then - OnMouseReleased(Self, AEvent.MouseButton, GetKeyboardShiftState, Point(LoWord(AEvent.lparam), HiWord(AEvent.lParam))) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMouseMove: - begin - if Assigned(OnMouseMove) then - OnMouseMove(Self, GetKeyboardShiftState, Point(LoWord(AEvent.lparam), HiWord(AEvent.lParam))) - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etMouseWheel: - begin - if Assigned(OnMouseWheel) then - begin - pt.x := LoWord(AEvent.lparam); - pt.y := HiWord(AEvent.lparam); - Windows.ScreenToClient(Handle, @pt); - OnMouseWheel(Self, GetKeyboardShiftState, SmallInt(HiWord(AEvent.wParam)) / -120.0, - Point(pt.x, pt.y)); - end - else if Assigned(Parent) then Parent.ProcessEvent(AEvent); - end; - etPaint: - begin - Windows.BeginPaint(Handle, @PaintStruct); - if Assigned(OnPaint) then - begin - r.Left := PaintStruct.rcPaint.Left; - r.Top := PaintStruct.rcPaint.Top; - r.Right := PaintStruct.rcPaint.Right; - r.Bottom := PaintStruct.rcPaint.Bottom; - - // graemeg: What is this extra canvas used for???? -// OldCanvas := Canvas; -// FCanvas := TGDICanvas.Create(PaintStruct.hdc); - OnPaint(Self, r); -// Canvas.Free; -// FCanvas := OldCanvas; - end; - Windows.EndPaint(Handle, @PaintStruct); - end; - etMove: - begin - if Assigned(OnMove) then OnMove(Self); - end; - etResize: - begin - if Assigned(OnResize) then OnResize(Self); - end; - etShow: - begin - if Assigned(OnShow) then OnShow(Self); - end; - end; +procedure TGDIWindow.EvMove; +begin + if Assigned(OnMove) then OnMove(Self); +end; + +procedure TGDIWindow.EvResize; +begin + if Assigned(OnResize) then OnResize(Self); +end; + +procedure TGDIWindow.EvShow; +begin + if Assigned(OnShow) then OnShow(Self); end; function TGDIWindow.GetTitle: String; @@ -1787,23 +1756,16 @@ function TGDIWindow.DoMouseEnterLeaveCheck(uMsg, wParam, lParam: Cardinal): Bool var pt: Windows.POINT; - Event: TFEvent; begin if not FMouseInWindow then begin FMouseInWindow := True; DoSetCursor; Windows.SetCapture(Handle); - Event := TFEvent.Create; - try - Event.lParam := lParam; - Event.EventType := etMouseEnter; - ProcessEvent(Event); - finally - Event.Free; - end; + EvMouseEnter(Point(LoWord(lparam), HiWord(lparam))); Result := uMsg <> WM_MOUSEMOVE; - end else + end + else begin pt.x := LoWord(lParam); pt.y := HiWord(lParam); @@ -1816,15 +1778,10 @@ begin if (not FHasMouseCapture) and (not FMouseInWindow) then begin Windows.ReleaseCapture; - Event := TFEvent.Create; - try - Event.EventType := etMouseLeave; - ProcessEvent(Event); - finally - Event.Free; - end; + EvMouseLeave; Result := False; - end else + end + else Result := True; end; end; diff --git a/gfx/gfxbase.pas b/gfx/gfxbase.pas index a790d4ba..6b263e61 100644 --- a/gfx/gfxbase.pas +++ b/gfx/gfxbase.pas @@ -511,9 +511,10 @@ type procedure DoSetCursor; virtual; abstract; function GetHandle: PtrUInt; virtual; abstract; public - constructor Create(AOwner: TComponent); override; + { Constructors / Destructors } constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); virtual; destructor Destroy; override; + { Widget controling methods } function CanClose: Boolean; virtual; procedure SetPosition(const APosition: TPoint); virtual; procedure SetSize(const ASize: TSize); virtual; @@ -525,13 +526,32 @@ type procedure PaintInvalidRegion; virtual; abstract; procedure CaptureMouse; virtual; abstract; procedure ReleaseMouse; virtual; abstract; - procedure ProcessEvent(AEvent: TFEvent); virtual; abstract; + { Event processing methods } +// procedure ProcessEvent(AEvent: TFEvent); virtual; abstract; + procedure EvCreate; virtual; abstract; + procedure EvFocusIn; virtual; abstract; + procedure EvFocusOut; virtual; abstract; + procedure EvHide; virtual; abstract; + procedure EvKeyPressed(AKey: Word); virtual; abstract; + procedure EvKeyReleased(AKey: Word); virtual; abstract; + procedure EvKeyChar(AKeyChar: Char); virtual; abstract; + procedure EvMouseEnter(const AMousePos: TPoint); virtual; abstract; + procedure EvMouseLeave; virtual; abstract; + procedure EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint); virtual; abstract; + procedure EvMouseReleased(AButton: TMouseButton; const AMousePos: TPoint); virtual; abstract; + procedure EvMouseMove(const AMousePos: TPoint); virtual; abstract; + procedure EvMouseWheel(AWheelDelta: Single; const AMousePos: TPoint); virtual; abstract; + procedure EvPaint; virtual; abstract; + procedure EvMove; virtual; abstract; + procedure EvResize; virtual; abstract; + procedure EvShow; virtual; abstract; + { Properties } property WindowOptions: TFWindowOptions read FWindowOptions write SetWindowOptions; property Canvas: TFCustomCanvas read FCanvas; property Handle: PtrUInt read GetHandle; property ChildWindows: TList read FChildWindows; - // Window state + { Window state } property Left: Integer read FLeft write SetLeft; property Top: Integer read FTop write SetTop; property Width: Integer read FWidth write SetWidth; @@ -541,7 +561,7 @@ type property Cursor: TFCursor read FCursor write SetCursor; property Title: String read GetTitle write SetTitle; property Parent: TFCustomWindow read FParent; - // Event handlers + { Event handlers } property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; property OnCanClose: TGfxCanCloseEvent read FOnCanClose write FOnCanClose; property OnClose: TNotifyEvent read FOnClose write FOnClose; @@ -1016,15 +1036,10 @@ begin // Empty end; -constructor TFCustomWindow.Create(AOwner: TComponent); -begin - inherited Create(AOwner); -end; - constructor TFCustomWindow.Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); begin - Create(nil); + inherited Create(nil); FWindowOptions := AWindowOptions; FParent := AParent; |