paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-15 13:49:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

added qt interface to IDE and fixed compilation

Browse Source 
git-svn-id: trunk@8430 -
This commit is contained in:
mattias 2006-01-04 10:28:58 +00:00
parent 9bfe055000
commit d452af1ba0
7 changed files with 107 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/codetools/codetoolsstrconsts.pas
View File

@ -202,6 +202,7 @@ ResourceString
ctsDefineMacroGTK2 = 'Define macro gtk2'; ctsDefineMacroGTK2 = 'Define macro gtk2';
ctsDefineMacroGnome2 = 'Define macro gnome2'; ctsDefineMacroGnome2 = 'Define macro gnome2';
ctsDefineMacroCarbon1 = 'Define macro carbon1'; ctsDefineMacroCarbon1 = 'Define macro carbon1';
ctsDefineMacroQT1 = 'Define macro qt1';
ctsGtk2IntfDirectory = 'gtk2 interface directory'; ctsGtk2IntfDirectory = 'gtk2 interface directory';
ctsDefineMacroWinCE1 = 'Define macro wince1'; ctsDefineMacroWinCE1 = 'Define macro wince1';
ctsGnomeIntfDirectory = 'gnome interface directory'; ctsGnomeIntfDirectory = 'gnome interface directory';

14
components/codetools/definetemplates.pas
View File

@ -3544,11 +3544,11 @@ function TDefinePool.CreateLazarusSrcTemplate(
const LazarusSrcDir, WidgetType, ExtraOptions: string; const LazarusSrcDir, WidgetType, ExtraOptions: string;
Owner: TObject): TDefineTemplate; Owner: TObject): TDefineTemplate;
type type
TLazWidgetSet = (wsGtk, wsGtk2, wsGnome, wsWin32, wsWinCE, wsCarbon); TLazWidgetSet = (wsGtk, wsGtk2, wsGnome, wsWin32, wsWinCE, wsCarbon, wsQT);
const const
ds: char = PathDelim; ds: char = PathDelim;
LazWidgetSets: array[TLazWidgetSet] of string = ( LazWidgetSets: array[TLazWidgetSet] of string = (
'gtk','gtk2','gnome','win32','wince','carbon'); 'gtk','gtk2','gnome','win32','wince','carbon','qt');
function D(const Filename: string): string; function D(const Filename: string): string;
begin begin
@ -3944,7 +3944,7 @@ begin
// <LazarusSrcDir>/lcl/interfaces/wince // <LazarusSrcDir>/lcl/interfaces/wince
IntfDirTemplate:=TDefineTemplate.Create('winceIntfDirectory', IntfDirTemplate:=TDefineTemplate.Create('winceIntfDirectory',
ctsIntfDirectory,'','wince',da_Directory); ctsIntfDirectory,'','wince',da_Directory);
// then define carbon1 // then define wince1
IntfDirTemplate.AddChild(TDefineTemplate.Create('Define wince1', IntfDirTemplate.AddChild(TDefineTemplate.Create('Define wince1',
ctsDefineMacroWinCE1,'wince1','',da_Define)); ctsDefineMacroWinCE1,'wince1','',da_Define));
SubDirTempl.AddChild(IntfDirTemplate); SubDirTempl.AddChild(IntfDirTemplate);
@ -3957,6 +3957,14 @@ begin
ctsDefineMacroCarbon1,'carbon1','',da_Define)); ctsDefineMacroCarbon1,'carbon1','',da_Define));
SubDirTempl.AddChild(IntfDirTemplate); SubDirTempl.AddChild(IntfDirTemplate);
// <LazarusSrcDir>/lcl/interfaces/qt
IntfDirTemplate:=TDefineTemplate.Create('qtIntfDirectory',
ctsIntfDirectory,'','qt',da_Directory);
// then define qt1
IntfDirTemplate.AddChild(TDefineTemplate.Create('Define qt1',
ctsDefineMacroQT1,'qt1','',da_Define));
SubDirTempl.AddChild(IntfDirTemplate);
// <LazarusSrcDir>/components // <LazarusSrcDir>/components
DirTempl:=TDefineTemplate.Create('Components',ctsComponentsDirectory, DirTempl:=TDefineTemplate.Create('Components',ctsComponentsDirectory,
'','components',da_Directory); '','components',da_Directory);

4
ide/buildlazdialog.pas
View File

@ -746,8 +746,8 @@ begin
y:=ItemsListBox.Top; y:=ItemsListBox.Top;
with LCLInterfaceRadioGroup do begin with LCLInterfaceRadioGroup do begin
SetBounds(x,y,w,150); SetBounds(x,y,w,200);
inc(y,Height+60); inc(y,Height+10);
end; end;
with WithStaticPackagesCheckBox do begin with WithStaticPackagesCheckBox do begin
SetBounds(x,y,w,Height); SetBounds(x,y,w,Height);

5
ide/lazconf.pp
View File

@ -55,13 +55,14 @@ type
lpGnome, lpGnome,
lpWin32, lpWin32,
lpWinCE, lpWinCE,
lpCarbon lpCarbon,
lpQT
); );
TLCLPlatforms = set of TLCLPlatform; TLCLPlatforms = set of TLCLPlatform;
const const
LCLPlatformNames: array[TLCLPlatform] of string = ( LCLPlatformNames: array[TLCLPlatform] of string = (
'gtk', 'gtk2', 'gnome', 'win32', 'wince', 'carbon' 'gtk', 'gtk2', 'gnome', 'win32', 'wince', 'carbon', 'qt'
); );

5
lcl/interfaces/qt/qtcallback.inc
View File

@ -43,7 +43,6 @@ end;
procedure QTMousePressedEvent(qwid,button,x,y,state: integer);cdecl; procedure QTMousePressedEvent(qwid,button,x,y,state: integer);cdecl;
var var
MessI : TLMMouse;
MessE : TLMMouseEvent; MessE : TLMMouseEvent;
Data: pointer; Data: pointer;
@ -60,8 +59,8 @@ begin
end; end;
// MessE.WheelDelta := 1; // MessE.WheelDelta := 1;
//MessE.State := state; //MessE.State := state;
MessE.X := TruncToInt(x); MessE.X := RoundToInt(x);
MessE.Y := TruncToInt(y); MessE.Y := RoundToInt(y);
if MessE.Msg <> LM_NULL then if MessE.Msg <> LM_NULL then

144
lcl/interfaces/qt/qtint.pp
View File

@ -34,47 +34,54 @@ interface
{$endif} {$endif}
uses uses
InterfaceBase, sysutils, LCLType, LMessages, Classes, Controls, InterfaceBase, SysUtils, LCLProc, LCLType, LMessages, Classes, Controls,
ExtCtrls, Forms, Dialogs, StdCtrls, Comctrls, LCLIntf, qt; ExtCtrls, Forms, Dialogs, StdCtrls, Comctrls, LCLIntf, GraphType,
qt;
type type
{ TQtWidgetSet }
TQtWidgetSet = Class(TWidgetSet) TQtWidgetSet = Class(TWidgetSet)
private private
procedure CreateComponent(Sender : TObject);
procedure ShowHide(Sender : TObject);
public public
{$I qtwinapih.inc} {$I qtwinapih.inc}
{$I qtlclintfh.inc} {$I qtlclintfh.inc}
public public
function GetText(Sender: TControl; var Text: String): Boolean; override; procedure AppInit(var ScreenInfo: TScreenInfo); override;
procedure SetLabel(Sender : TObject; Data : Pointer); procedure AppRun(const ALoop: TApplicationMainLoop); override;
function IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer; override; procedure AppWaitMessage; override;
procedure SetCallback(Msg : LongInt; Sender : TObject); override;
procedure RemoveCallbacks(Sender : TObject); override;
procedure DoEvents; override;
procedure AppProcessMessages; override; procedure AppProcessMessages; override;
procedure AppTerminate; override; procedure AppTerminate; override;
procedure Init; override; procedure AppMinimize; override;
procedure AppBringToFront; override;
function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
procedure DCRedraw(CanvasHandle: HDC); override;
procedure SetDesigning(AComponent: TComponent); override;
function InitHintFont(HintFont: TObject): Boolean; override;
// create and destroy
function CreateComponent(Sender : TObject): THandle; override;
function CreateTimer(Interval: integer; TimerFunc: TFNTimerProc): integer; override;
function DestroyTimer(TimerHandle: integer): boolean; override;
end; end;
type type
TEventProc = record
Name : String[25];
CallBack : Procedure(Data : TObject);
Data : Pointer;
End;
TEventProc = record CallbackProcedure = Procedure (Data : Pointer);
Name : String[25];
CallBack : Procedure(Data : TObject);
Data : Pointer;
End;
CallbackProcedure = Procedure (Data : Pointer); pTRect = ^TRect;
pTRect = ^TRect;
procedure EventTrace(message : string; data : pointer);
procedure EventTrace(message : string; data : pointer);
const const
@ -124,103 +131,18 @@ const
KEYMAP_TOGGLE = $20000; KEYMAP_TOGGLE = $20000;
KEYMAP_EXTENDED = $40000; KEYMAP_EXTENDED = $40000;
// PDB: note this is a hack. Windows maintains a system wide procedure EventTrace(message: string; data: pointer);
// system color table we will have to have our own begin
// to be able to do the translations required from
// window manager to window manager this means every
// application will carry its own color table
// we set the defaults here to reduce the initial
// processing of creating a default table
// MWE: Naaaaah, not a hack, just something temporary
const
SysColorMap: array [0..MAX_SYS_COLORS] of DWORD = (
$C0C0C0, {COLOR_SCROLLBAR}
$808000, {COLOR_BACKGROUND}
$800000, {COLOR_ACTIVECAPTION}
$808080, {COLOR_INACTIVECAPTION}
$C0C0C0, {COLOR_MENU}
$FFFFFF, {COLOR_WINDOW}
$000000, {COLOR_WINDOWFRAME}
$000000, {COLOR_MENUTEXT}
$000000, {COLOR_WINDOWTEXT}
$FFFFFF, {COLOR_CAPTIONTEXT}
$C0C0C0, {COLOR_ACTIVEBORDER}
$C0C0C0, {COLOR_INACTIVEBORDER}
$808080, {COLOR_APPWORKSPACE}
$800000, {COLOR_HIGHLIGHT}
$FFFFFF, {COLOR_HIGHLIGHTTEXT}
$C0C0C0, {COLOR_BTNFACE}
$808080, {COLOR_BTNSHADOW}
$808080, {COLOR_GRAYTEXT}
$000000, {COLOR_BTNTEXT}
$C0C0C0, {COLOR_INACTIVECAPTIONTEXT}
$FFFFFF, {COLOR_BTNHIGHLIGHT}
$000000, {COLOR_3DDKSHADOW}
$C0C0C0, {COLOR_3DLIGHT}
$000000, {COLOR_INFOTEXT}
$E1FFFF, {COLOR_INFOBK}
$000000, {unasigned}
$000000, {COLOR_HOTLIGHT}
$000000, {COLOR_GRADIENTACTIVECAPTION}
$000000 {COLOR_GRADIENTINACTIVECAPTION}
); {end _SysColors}
type
TGDIType = (gdiBitmap, gdiBrush, gdiFont, gdiPen, gdiRegion);
TGDIBitmapType = (gbBitmap, gbPixmap, gbImage);
PGDIRGB = ^TGDIRGB;
TGDIRGB = record
Red,
Green,
Blue: Byte;
end;
PGDIRawImage = ^TGDIRawImage;
TGDIRawImage = record
Height,
Width: Integer;
Depth: Byte;
Data: array[0..0] of TGDIRGB;
end;
var
DeviceContexts: TList;
GDIObjects: TList;
KeyStateList: TList; // Keeps track of which keys are pressed
const
TARGET_STRING = 1;
TARGET_ROOTWIN = 2;
end;
{$I qtobject.inc} {$I qtobject.inc}
{$I qtwinapi.inc} {$I qtwinapi.inc}
{$I qtcallback.inc} {$I qtcallback.inc}
{$I qtobject.inc}
var
n: Integer;
initialization initialization
DeviceContexts := TList.Create;
GDIObjects := TList.Create;
KeyStateList := TList.Create;
finalization finalization
if (DeviceContexts.Count > 0) or (GDIObjects.Count > 0)
then begin
DebugLn(Format('[QTInt] WARNING: There are %d unreleased DCs and %d unreleased GDIObjects' ,[DeviceContexts.Count, GDIObjects.Count]));
end;
DeviceContexts.Free;
GDIObjects.Free;
KeyStateList.Free;
end. end.

191
lcl/interfaces/qt/qtobject.inc
View File

@ -14,163 +14,82 @@
} }
//--------------------------------------------------------------- //---------------------------------------------------------------
procedure EventTrace(message : string; data : pointer); function TQtWidgetSet.CreateTimer(Interval: integer; TimerFunc: TFNTimerProc
): integer;
begin begin
Result:=0;
end; end;
function TQtWidgetSet.DestroyTimer(TimerHandle: integer): boolean;
function TQtWidgetSet.GetText(Sender: TControl; var Text: String): Boolean;
begin begin
end; Result:=false;
procedure TQtWidgetSet.SetLabel(Sender : TObject; Data : Pointer);
var
pLabel: pchar;
lSelf : TWinControl;
begin
lSelf := Sender as TWinControl;
pLabel := pchar(Data);
SetWidgetText(lSelf.Handle,pLabel);
end; end;
function TQtWidgetSet.IntSendMessage3(LM_Message : Integer; Sender : TObject;data : pointer) : integer; procedure TQtWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
var
lParent: TWinControl;
lSelf: TWinControl;
begin begin
// Assert(False, 'Trace:' + IntToStr(LM_Message)); InitializeEngine;
case LM_Message of
LM_SetLabel :
begin
SetLabel(Sender,Data);
end;
LM_ADDCHILD:
begin
if assigned((Sender as TWinControl).Parent) then
begin
lSelf := Sender as TWinControl;
lParent := (Sender as TWinControl).Parent;
ReparentWidget(lParent.Handle,lSelf.Handle);
end;
end;
LM_Create :
begin
Assert(False, 'Trace:Calling CreateComponent');
CreateComponent(Sender);
Assert(False, 'Trace:Called CreateComponent');
end;
LM_SHOWHIDE:
begin
ShowHide(Sender);
end;
LM_SetSize :
begin
lSelf := Sender as TWinControl;
// Assert(False, 'Trace:' + IntTostr(lSelf.Handle));
MoveWidget(lSelf.Handle, pTRect(Data)^.Left, pTRect(Data)^.Top);
ResizeWidget(lSelf.Handle, pTRect(Data)^.Right,pTRect(Data)^.Bottom);
SetWidgetText(lSelf.Handle,'test');
end;
end;//end case
end; end;
procedure TQtWidgetSet.CreateComponent(Sender : TObject); procedure TQtWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
var
CompStyle: integer;
lHandle: integer;
begin begin
lHandle := -1;
if (Sender is TControl) then
CompStyle := TControl(Sender).FCompStyle;
case CompStyle of
csForm:
begin
Assert(False, 'Trace:CREATE FORM');
lHandle := CreateWidget(WIDGET);
SetData(lHandle,Sender);
end;
csButton:
begin
lHandle := CreateWidget(WIDGET_PUSH_BUTTON);
SetData(lHandle,Sender);
end;
end;//case
if (lHandle > -1) then
if (Sender is TWinControl) then
TWinControl(Sender).Handle := THandle(lhandle);
end;
procedure TQtWidgetSet.ShowHide(Sender : TObject);
begin
//put in hide code once the interface supports it
if TControl(Sender).Visible then
ShowWidget(TWinControl(Sender).Handle);
end;
procedure TQtWidgetSet.SetCallback(Msg : LongInt; Sender : TObject);
var
lHandle : integer;
begin
if not assigned(Sender) then
exit;
lHandle := (Sender as TWinControl).Handle;
case Msg of
LM_LBUTTONDOWN,
LM_RBUTTONDOWN,
LM_MBUTTONDOWN,
LM_MOUSEWHEEL :
begin
Assert(False, 'Trace:BUTTON DOWN CONNECT REQUEST');
HookMousePressedEvent(lHandle,@QTMousePressedEvent);
// ConnectSignal(gFixed, 'button-press-event', @gtkmousebtnpress, GDK_BUTTON_PRESS_MASK);
end;
LM_LBUTTONUP,
LM_RBUTTONUP,
LM_MBUTTONUP:
begin
// HookMousePressedEvent(lHandle,@QTMousePressedEvent);
end;
end;//case
end; end;
procedure TQtWidgetSet.RemoveCallbacks(Sender : TObject); procedure TQtWidgetSet.AppWaitMessage;
begin begin
end; end;
procedure TQtWidgetSet.DoEvents;
begin
Assert(False, 'Trace:*******QT ENGINE HAS ENTERED EVENT ITTERATOR*******');
end;
procedure TQtWidgetSet.AppProcessMessages; procedure TQtWidgetSet.AppProcessMessages;
begin begin
MainLoop; MainLoop;
end; end;
procedure TQtWidgetSet.AppTerminate; procedure TQtWidgetSet.AppTerminate;
begin begin
Assert(False, 'Trace:*******APP TERMINATE CALLED*****'); Assert(False, 'Trace:*******APP TERMINATE CALLED*****');
Shutdown; Shutdown;
end; end;
procedure TQtWidgetSet.Init;
procedure TQtWidgetSet.AppMinimize;
begin begin
InitializeEngine;
end;
procedure TQtWidgetSet.AppBringToFront;
begin
end;
function TQtWidgetSet.DCGetPixel(CanvasHandle: HDC; X, Y: integer
): TGraphicsColor;
begin
Result:=clNone;
end;
procedure TQtWidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer;
AColor: TGraphicsColor);
begin
end;
procedure TQtWidgetSet.DCRedraw(CanvasHandle: HDC);
begin
end;
procedure TQtWidgetSet.SetDesigning(AComponent: TComponent);
begin
end;
function TQtWidgetSet.InitHintFont(HintFont: TObject): Boolean;
begin
Result:=false;
end;
function TQtWidgetSet.CreateComponent(Sender: TObject): THandle;
begin
Result:=0;
end; end;
//------------------------------------------------------------------------ //------------------------------------------------------------------------