From 3c479a4c97c9445e7aba0bcda2fbbf325448e11a Mon Sep 17 00:00:00 2001 From: Felipe Menteiro de Carvalho Date: Mon, 20 Nov 2006 18:23:23 +0000 Subject: Added support for sub windows on Gfx, and also an example program for this --- examples/gfx/eventtest/eventtest.lpi | 5 +- examples/gfx/eventtest/eventtest.pas | 10 ++-- examples/gfx/helloworld/helloworld.lpi | 10 ++-- examples/gfx/subwindow/subwindow.lpi | 49 ++++++++++++++++ examples/gfx/subwindow/subwindow.pas | 100 +++++++++++++++++++++++++++++++++ examples/gui/helloworld/helloworld.lpi | 10 ++-- examples/gui/helloworld/helloworld.pas | 2 +- gfx/gdi/gfx_gdi.pas | 65 +++++++++++---------- 8 files changed, 203 insertions(+), 48 deletions(-) create mode 100644 examples/gfx/subwindow/subwindow.lpi create mode 100644 examples/gfx/subwindow/subwindow.pas diff --git a/examples/gfx/eventtest/eventtest.lpi b/examples/gfx/eventtest/eventtest.lpi index 20cb4496..3562e167 100644 --- a/examples/gfx/eventtest/eventtest.lpi +++ b/examples/gfx/eventtest/eventtest.lpi @@ -1,7 +1,7 @@ - + @@ -20,7 +20,7 @@ - + @@ -39,6 +39,7 @@ + diff --git a/examples/gfx/eventtest/eventtest.pas b/examples/gfx/eventtest/eventtest.pas index 8b371478..4fb7593a 100644 --- a/examples/gfx/eventtest/eventtest.pas +++ b/examples/gfx/eventtest/eventtest.pas @@ -17,12 +17,10 @@ program EventTest; uses - SysUtils - ,Classes - ,GFXBase - ,fpGFX - ; - + SysUtils, + Classes, + GFXBase, + fpGFX; const ButtonNames: array[TMouseButton] of PChar = diff --git a/examples/gfx/helloworld/helloworld.lpi b/examples/gfx/helloworld/helloworld.lpi index 66ec049a..f31d1721 100644 --- a/examples/gfx/helloworld/helloworld.lpi +++ b/examples/gfx/helloworld/helloworld.lpi @@ -1,7 +1,7 @@ - + @@ -14,13 +14,14 @@ + - + @@ -30,14 +31,15 @@ - + - + + diff --git a/examples/gfx/subwindow/subwindow.lpi b/examples/gfx/subwindow/subwindow.lpi new file mode 100644 index 00000000..14c843c7 --- /dev/null +++ b/examples/gfx/subwindow/subwindow.lpi @@ -0,0 +1,49 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/gfx/subwindow/subwindow.pas b/examples/gfx/subwindow/subwindow.pas new file mode 100644 index 00000000..177f4989 --- /dev/null +++ b/examples/gfx/subwindow/subwindow.pas @@ -0,0 +1,100 @@ +{ + fpGUI - Free Pascal GUI Library + + SubWindow - Shows how to create a Sub-Window on GFX + + Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this + distribution, for details of the copyright. + + See the file COPYING.modifiedLGPL, included in this distribution, + for details about redistributing fpGUI. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +program subwindow; + +uses + SysUtils, Classes, + fpGFX, GFXBase, fpgfxpackage; + +type + + { TBoxWindow } + + TBoxWindow = class(TFWindow) + public + procedure Paint(Sender: TObject; const Rect: TRect); + constructor Create(AParent: TFCustomWindow); + procedure MouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + end; + + { TMainWindow } + + TMainWindow = class(TFWindow) + public + ABox: TBoxWindow; + constructor Create; + procedure MouseReleased(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + end; + +constructor TBoxWindow.Create(AParent: TFCustomWindow); +begin + inherited Create(AParent, []); + + OnMouseReleased := @MouseReleased; + OnPaint := @Paint; + + SetClientSize(Size(125, 125)); + SetMinMaxClientSize(Size(125, 125), Size(125, 125)); +end; + +procedure TBoxWindow.MouseReleased(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); +begin + WriteLn('Mouse released on child window'); +end; + +procedure TBoxWindow.Paint(Sender: TObject; const Rect: TRect); +var + r: TRect; +begin + Canvas.SetColor(colBlue); + r.Left := 0; + r.Top := 0; + r.Right := Width; + r.Bottom := Height; + Canvas.FillRect(r); +end; + +constructor TMainWindow.Create; +begin + inherited Create(nil, [woWindow]); + + Title := 'fpGFX Sub-Window example'; + SetClientSize(Size(256, 256)); + SetMinMaxClientSize(Size(256, 256), Size(256, 256)); + + OnMouseReleased := @MouseReleased; + + ABox := TBoxWindow.Create(Self); + ABox.Show; +end; + +procedure TMainWindow.MouseReleased(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; const AMousePos: TPoint); +begin + WriteLn('Mouse released on main window'); +end; + +var + MainWindow: TMainWindow; +begin + GFApplication.Initialize; + MainWindow := TMainWindow.Create; + GFApplication.AddWindow(MainWindow); + MainWindow.Show; + GFApplication.Run; +end. + diff --git a/examples/gui/helloworld/helloworld.lpi b/examples/gui/helloworld/helloworld.lpi index f9e413e9..c180f8dc 100644 --- a/examples/gui/helloworld/helloworld.lpi +++ b/examples/gui/helloworld/helloworld.lpi @@ -1,7 +1,7 @@ - + @@ -14,6 +14,7 @@ + @@ -21,12 +22,12 @@ - + - + @@ -39,8 +40,9 @@ + - + diff --git a/examples/gui/helloworld/helloworld.pas b/examples/gui/helloworld/helloworld.pas index 8151291a..b9921756 100644 --- a/examples/gui/helloworld/helloworld.pas +++ b/examples/gui/helloworld/helloworld.pas @@ -3,7 +3,7 @@ program HelloWorld; {$mode objfpc}{$h+} uses - fpGUI, fpGUI_laz; + fpGUI, fpguipackage; type TMainForm = class(TForm) diff --git a/gfx/gdi/gfx_gdi.pas b/gfx/gdi/gfx_gdi.pas index 82ce1214..219461d0 100644 --- a/gfx/gdi/gfx_gdi.pas +++ b/gfx/gdi/gfx_gdi.pas @@ -1075,52 +1075,55 @@ begin FParent := AParent; { Initialize a window class, if necessary } - if UnicodeEnabledOS then + if woWindow in WindowOptions then begin - if not Assigned(WindowClassW.lpfnWndProc) then + if UnicodeEnabledOS 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 + 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 - 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'; + 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; - Windows.RegisterClass(@WindowClass); end; - + if Assigned(AParent) then ParentHandle := AParent.Handle else ParentHandle := 0; - if (woBorderless in FWindowOptions) and (woPopUp in FWindowOptions) then FWindowStyle := WS_POPUP + 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_OVERLAPPED + 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 if woWindow in FWindowOptions then FWindowStyle := WS_OVERLAPPEDWINDOW - else FWindowStyle := 0; + else FWindowStyle := WS_OVERLAPPEDWINDOW; - if woPopUp in FWindowOptions then FWindowStyleEx := WS_EX_TOOLWINDOW + 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 if woWindow in FWindowOptions then FWindowStyleEx := WS_EX_APPWINDOW - else FWindowStyleEx := 0; + else FWindowStyleEx := WS_EX_APPWINDOW; if UnicodeEnabledOS then FHandle := Windows.CreateWindowExW( -- cgit v1.2.3-70-g09d2