diff options
| -rw-r--r-- | gfx/gdi/gfx_gdi.pas | 183 | ||||
| -rw-r--r-- | gfx/gfxbase.pas | 59 |
2 files changed, 120 insertions, 122 deletions
diff --git a/gfx/gdi/gfx_gdi.pas b/gfx/gdi/gfx_gdi.pas index 0bab2535..d59d91ca 100644 --- a/gfx/gdi/gfx_gdi.pas +++ b/gfx/gdi/gfx_gdi.pas @@ -182,10 +182,13 @@ type WindowClassW: TWndClassW; FWindowStyle, FWindowStyleEx: LongWord; FMouseInWindow, FHasMouseCapture, FHasFocus: Boolean; - function GetTitle: String; override; - procedure SetTitle(const ATitle: String); override; + + { Internal resource allocation methods } procedure DoSetCursor; override; + procedure DoSetWindowOptions; override; function GetHandle: PtrUInt; override; + procedure CreateWindow; override; + { Internal methods specific to the win backend } procedure UpdateWindowButtons; function DoMouseEnterLeaveCheck(uMsg, wParam, lParam: Cardinal): Boolean; procedure EvInternalPaint; @@ -212,6 +215,8 @@ type constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); override; destructor Destroy; override; { Widget controling methods } + function GetTitle: String; override; + procedure SetTitle(const ATitle: String); override; procedure SetPosition(const APosition: TPoint); override; procedure SetSize(const ASize: TSize); override; procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); override; @@ -1308,90 +1313,10 @@ end; constructor TGDIWindow.Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); -var - ParentHandle: HWND; begin inherited Create(AParent, AWindowOptions); - { Initialize a window class, if necessary } - if woWindow in WindowOptions then - begin - if UnicodeEnabledOS then - begin - if not Assigned(WindowClassW.lpfnWndProc) then - begin - WindowClassW.style := CS_HREDRAW or CS_VREDRAW; - WindowClassW.lpfnWndProc := WndProc(@fpGFXWindowProc); - WindowClassW.hInstance := MainInstance; - WindowClassW.hIcon := LoadIcon(0, IDI_APPLICATION); - WindowClassW.hCursor := LoadCursor(0, IDC_ARROW); - WindowClassW.hbrBackground := 0; - WindowClassW.lpszClassName := 'fpGFX'; - end; - Windows.RegisterClassW(@WindowClassW); - end - else - begin - if not Assigned(WindowClass.lpfnWndProc) then - begin - WindowClass.style := CS_HREDRAW or CS_VREDRAW; - WindowClass.lpfnWndProc := WndProc(@fpGFXWindowProc); - WindowClass.hInstance := MainInstance; - WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION); - WindowClass.hCursor := LoadCursor(0, IDC_ARROW); - WindowClass.hbrBackground := 0; - WindowClass.lpszClassName := 'fpGFX'; - end; - Windows.RegisterClass(@WindowClass); - end; - end; - - if Assigned(AParent) then - ParentHandle := AParent.Handle - else - ParentHandle := 0; - - if not (woWindow in FWindowOptions) then FWindowStyle := WS_CHILD - else if (woBorderless in FWindowOptions) and (woPopUp in FWindowOptions) then FWindowStyle := WS_POPUP - else if woPopUp in FWindowOptions then FWindowStyle := WS_POPUPWINDOW - else if woToolWindow in FWindowOptions then FWindowStyle := WS_OVERLAPPEDWINDOW - else if woChildWindow in FWindowOptions then FWindowStyle := WS_CHILDWINDOW - else if woBorderless in FWindowOptions then FWindowStyle := WS_OVERLAPPED - else FWindowStyle := WS_OVERLAPPEDWINDOW; - - if not (woWindow in FWindowOptions) then FWindowStyleEx := 0 - else if woPopUp in FWindowOptions then FWindowStyleEx := WS_EX_TOOLWINDOW - else if woToolWindow in FWindowOptions then FWindowStyleEx := WS_EX_TOOLWINDOW - else FWindowStyleEx := WS_EX_APPWINDOW; - - if UnicodeEnabledOS then - FHandle := Windows.CreateWindowExW( - FWindowStyleEx, // extended window style - 'fpGFX', // registered class name - 'fpGFX Window', // window name - FWindowStyle, // window style - CW_USEDEFAULT, // horizontal position of window - CW_USEDEFAULT, // vertical position of window - CW_USEDEFAULT, // window width - CW_USEDEFAULT, // window height - ParentHandle, // handle to parent or owner window - 0, // menu handle or child identifier - MainInstance, // handle to application instance - Self) // window-creation data - else - FHandle := Windows.CreateWindowEx( - FWindowStyleEx, // extended window style - 'fpGFX', // registered class name - 'fpGFX Window', // window name - FWindowStyle, // window style - CW_USEDEFAULT, // horizontal position of window - CW_USEDEFAULT, // vertical position of window - CW_USEDEFAULT, // window width - CW_USEDEFAULT, // window height - ParentHandle, // handle to parent or owner window - 0, // menu handle or child identifier - MainInstance, // handle to application instance - Self); // window-creation data + CreateWindow; { Creates the Canvas } @@ -1831,11 +1756,103 @@ begin end; end; +procedure TGDIWindow.DoSetWindowOptions; +begin + // implement me +end; + function TGDIWindow.GetHandle: PtrUInt; begin +// if FHandle = 0 then CreateWindow; + Result := FHandle; end; +procedure TGDIWindow.CreateWindow; +var + ParentHandle: HWND; +begin + { Initialize a window class, if necessary } + if woWindow in WindowOptions then + begin + if UnicodeEnabledOS then + begin + if not Assigned(WindowClassW.lpfnWndProc) then + begin + WindowClassW.style := CS_HREDRAW or CS_VREDRAW; + WindowClassW.lpfnWndProc := WndProc(@fpGFXWindowProc); + WindowClassW.hInstance := MainInstance; + WindowClassW.hIcon := LoadIcon(0, IDI_APPLICATION); + WindowClassW.hCursor := LoadCursor(0, IDC_ARROW); + WindowClassW.hbrBackground := 0; + WindowClassW.lpszClassName := 'fpGFX'; + end; + Windows.RegisterClassW(@WindowClassW); + end + else + begin + if not Assigned(WindowClass.lpfnWndProc) then + begin + WindowClass.style := CS_HREDRAW or CS_VREDRAW; + WindowClass.lpfnWndProc := WndProc(@fpGFXWindowProc); + WindowClass.hInstance := MainInstance; + WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION); + WindowClass.hCursor := LoadCursor(0, IDC_ARROW); + WindowClass.hbrBackground := 0; + WindowClass.lpszClassName := 'fpGFX'; + end; + Windows.RegisterClass(@WindowClass); + end; + end; + + if Assigned(FParent) then + ParentHandle := FParent.Handle + else + ParentHandle := 0; + + if not (woWindow in FWindowOptions) then FWindowStyle := WS_CHILD + else if (woBorderless in FWindowOptions) and (woPopUp in FWindowOptions) then FWindowStyle := WS_POPUP + else if woPopUp in FWindowOptions then FWindowStyle := WS_POPUPWINDOW + else if woToolWindow in FWindowOptions then FWindowStyle := WS_OVERLAPPEDWINDOW + else if woChildWindow in FWindowOptions then FWindowStyle := WS_CHILDWINDOW + else if woBorderless in FWindowOptions then FWindowStyle := WS_OVERLAPPED + else FWindowStyle := WS_OVERLAPPEDWINDOW; + + if not (woWindow in FWindowOptions) then FWindowStyleEx := 0 + else if woPopUp in FWindowOptions then FWindowStyleEx := WS_EX_TOOLWINDOW + else if woToolWindow in FWindowOptions then FWindowStyleEx := WS_EX_TOOLWINDOW + else FWindowStyleEx := WS_EX_APPWINDOW; + + if UnicodeEnabledOS then + FHandle := Windows.CreateWindowExW( + FWindowStyleEx, // extended window style + 'fpGFX', // registered class name + 'fpGFX Window', // window name + FWindowStyle, // window style + CW_USEDEFAULT, // horizontal position of window + CW_USEDEFAULT, // vertical position of window + CW_USEDEFAULT, // window width + CW_USEDEFAULT, // window height + ParentHandle, // handle to parent or owner window + 0, // menu handle or child identifier + MainInstance, // handle to application instance + Self) // window-creation data + else + FHandle := Windows.CreateWindowEx( + FWindowStyleEx, // extended window style + 'fpGFX', // registered class name + 'fpGFX Window', // window name + FWindowStyle, // window style + CW_USEDEFAULT, // horizontal position of window + CW_USEDEFAULT, // vertical position of window + CW_USEDEFAULT, // window width + CW_USEDEFAULT, // window height + ParentHandle, // handle to parent or owner window + 0, // menu handle or child identifier + MainInstance, // handle to application instance + Self); // window-creation data +end; + procedure TGDIWindow.UpdateWindowButtons; var diff --git a/gfx/gfxbase.pas b/gfx/gfxbase.pas index bf50bbfd..bed76023 100644 --- a/gfx/gfxbase.pas +++ b/gfx/gfxbase.pas @@ -461,7 +461,7 @@ type TGfxPaintEvent = procedure(Sender: TObject; const ARect: TRect) of object; - TFCustomWindow = class(TComponent) + TFCustomWindow = class(TObject) private FCursor: TFCursor; FOnCreate: TNotifyEvent; @@ -483,6 +483,7 @@ type FOnMove: TNotifyEvent; FOnResize: TNotifyEvent; FOnShow: TNotifyEvent; + { Property setting methods mapped to other methods } procedure SetClientHeight(const AValue: Integer); procedure SetClientWidth(const AValue: Integer); procedure SetLeft(const AValue: Integer); @@ -490,7 +491,7 @@ type procedure SetWidth(AWidth: Integer); procedure SetHeight(AHeight: Integer); procedure SetCursor(ACursor: TFCursor); - procedure SetWindowOptions(const AValue: TFWindowOptions); virtual; + procedure SetWindowOptions(const AValue: TFWindowOptions); protected FParent: TFCustomWindow; FCanvas: TFCustomCanvas; @@ -503,10 +504,12 @@ type FWindowOptions: TFWindowOptions; FChildWindows: TList; FMinSize, FMaxSize: TSize; - function GetTitle: String; virtual; - procedure SetTitle(const ATitle: String); virtual; + + { Internal resource allocation methods } procedure DoSetCursor; virtual; abstract; + procedure DoSetWindowOptions; virtual; abstract; function GetHandle: PtrUInt; virtual; abstract; + procedure CreateWindow; virtual; abstract; { Event processing methods } procedure EvCreate; virtual; abstract; @@ -532,11 +535,13 @@ type destructor Destroy; override; { Widget controling methods } function CanClose: Boolean; virtual; - procedure SetPosition(const APosition: TPoint); virtual; - procedure SetSize(const ASize: TSize); virtual; - procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); virtual; - procedure SetClientSize(const ASize: TSize); virtual; - procedure SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); virtual; + function GetTitle: String; virtual; + procedure SetTitle(const ATitle: String); virtual; + procedure SetPosition(const APosition: TPoint); virtual; abstract; + procedure SetSize(const ASize: TSize); virtual; abstract; + procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); virtual; abstract; + procedure SetClientSize(const ASize: TSize); virtual; abstract; + procedure SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); virtual; abstract; procedure Show; virtual; abstract; procedure Invalidate; virtual; abstract; procedure CaptureMouse; virtual; abstract; @@ -1004,39 +1009,14 @@ begin Result := True; end; -procedure TFCustomWindow.SetPosition(const APosition: TPoint); -begin - // Empty -end; - -procedure TFCustomWindow.SetSize(const ASize: TSize); -begin - // Empty -end; - -procedure TFCustomWindow.SetMinMaxSize(const AMinSize, AMaxSize: TSize); -begin - // Empty -end; - -procedure TFCustomWindow.SetClientSize(const ASize: TSize); -begin - // Empty -end; - -procedure TFCustomWindow.SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); -begin - // Empty -end; - function TFCustomWindow.GetTitle: String; begin - SetLength(Result, 0); + end; procedure TFCustomWindow.SetTitle(const ATitle: String); begin - // Empty + end; procedure TFCustomWindow.ProcessEvent(AEvent: TFEvent); @@ -1067,7 +1047,7 @@ end; constructor TFCustomWindow.Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); begin - inherited Create(nil); + inherited Create; FWindowOptions := AWindowOptions; FParent := AParent; @@ -1125,8 +1105,9 @@ end; procedure TFCustomWindow.SetWindowOptions(const AValue: TFWindowOptions); begin - if FWindowOptions=AValue then exit; - FWindowOptions:=AValue; + if FWindowOptions = AValue then exit; + FWindowOptions := AValue; + DoSetWindowOptions; end; { Global functions } |