paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 18:08:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

MWE:

Browse Source 
= Moved ObjectToGTKObject to GTKProc unit
  * Fixed array checking in LoadPixmap
  = Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
  ~ Some cleanup

git-svn-id: trunk@17 -
This commit is contained in:
lazarus 2000-07-30 21:48:34 +00:00
parent 7c2504eb94
commit 1cc50fde23
15 changed files with 548 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/controls.pp
View File

@ -436,7 +436,7 @@ TCMDialogKey = TLMKEY;
procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
procedure WMDragStart(Var Message: TLMessage); message LM_DRAGSTART; //not in delphi
Procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure CMHitTest(Var Message: TCMHittest) ; Message CM_HITTEST;
Procedure CMMouseEnter(var Message :TLMessage); message CM_MouseEnter;
Procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
@ -621,6 +621,7 @@ TCMDialogKey = TLMKEY;
procedure PaintHandler(var Message: TLMPaint);
procedure PaintWindow(DC: HDC); virtual;
{ events need to be protected otherwise they can't be overridden ??}
procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
procedure WMEraseBkgnd(var Message : TLMEraseBkgnd); message LM_ERASEBKGND;
procedure WMMove(var Message: TLMMove); message LM_MOVE;
procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY;
@ -1122,6 +1123,13 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:23 michael
+ Initial import

96
lcl/include/control.inc
View File

@ -88,9 +88,9 @@ end;
{ TControl.CMENABLEDCHANGED
}
{------------------------------------------------------------------------------}
Procedure TControl.CMEnabledChanged(var Message: TLMEssage);
Begin
invalidate;
procedure TControl.CMEnabledChanged(var Message: TLMEssage);
begin
invalidate;
end;
{------------------------------------------------------------------------------}
@ -280,12 +280,12 @@ end;
{------------------------------------------------------------------------------}
Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State : TDragState; var Accept:Boolean);
begin
Accept := False;
if Assigned(FOnDragOver) then
Begin
Accept := True;
//Do something else yet....
End;
Accept := False;
if Assigned(FOnDragOver)
then begin
Accept := True;
//Do something else yet....
end;
end;
@ -337,9 +337,9 @@ end;
{------------------------------------------------------------------------------}
{ TControl GetEnabled }
{------------------------------------------------------------------------------}
Function TControl.GetEnabled: Boolean;
Begin
Result := FEnabled;
function TControl.GetEnabled: Boolean;
begin
Result := FEnabled;
end;
{------------------------------------------------------------------------------}
@ -411,12 +411,12 @@ begin
end;
LM_LBUTTONDOWN,
LM_LBUTTONDBLCLK: begin
if FDragMode = dmAutomatic then
begin
if FDragMode = dmAutomatic
then begin
Assert(False, 'Trace:Begin AutoDrag called');
BeginAutoDrag;
Exit;
end;
Exit;
end;
Include(FControlState,csLButtonDown);
end;
LM_LBUTTONUP:
@ -638,14 +638,14 @@ end;
{------------------------------------------------------------------------------}
procedure TControl.SetCursor(Value: TCursor);
begin
If FCursor <> Value then
Begin
FCursor := Value;
//This should not be called if it is already set to VALUE but if
//it's not created when it's set, and you set it again it skips this, so for now I do it this way.
//later, I'll create the cursor in the CreateComponent (or something like that)
CNSendMessage(LM_SetCursor,Self,Nil);
End;
if FCursor <> Value
then begin
FCursor := Value;
//This should not be called if it is already set to VALUE but if
//it's not created when it's set, and you set it again it skips this, so for now I do it this way.
//later, I'll create the cursor in the CreateComponent (or something like that)
CNSendMessage(LM_SetCursor,Self,Nil);
end;
end;
@ -654,12 +654,11 @@ end;
{------------------------------------------------------------------------------}
procedure TControl.SetEnabled(Value: Boolean);
begin
If FEnabled <> Value then
Begin
FEnabled := Value;
CNSendMessage(LM_SETENABLED,Self,nil);
Perform(CM_ENABLEDCHANGED, 0,0);
End;
if FEnabled <> Value
then begin
FEnabled := Value;
Perform(CM_ENABLEDCHANGED, 0, 0);
end;
end;
@ -908,23 +907,23 @@ end;
{------------------------------------------------------------------------------}
Procedure TControl.SetParentShowHint(Value : Boolean);
Begin
If FParentShowHint <> Value then
Begin
FParentShowHint := Value;
//Sendmessage to stop/start hints for parent
end;
if FParentShowHint <> Value
then begin
FParentShowHint := Value;
//Sendmessage to stop/start hints for parent
end;
end;
{------------------------------------------------------------------------------}
{ TControl SetPopupMenu }
{------------------------------------------------------------------------------}
Procedure TControl.SetPopupMenu(Value : TPopupMenu);
Begin
FPopupMenu := Value;
procedure TControl.SetPopupMenu(Value : TPopupMenu);
begin
FPopupMenu := Value;
{ If Value <> nil then
Begin
begin
End;
end;
}
end;
@ -955,9 +954,9 @@ Begin
CaptureControl := Self;
end;
}
if not (csNoStdEvents in COntrolStyle) then
with Message do
MouseMove(KeystoShiftState(Keys), XPos, YPos);
if not (csNoStdEvents in COntrolStyle)
then with Message do
MouseMove(KeystoShiftState(Keys), XPos, YPos);
End;
@ -968,7 +967,7 @@ End;
Procedure TControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y: Integer);
begin
if Assigned(FOnMOuseDown) then FOnMOuseDOwn(Self, Button, Shift, X,Y);
if Assigned(FOnMOuseDown) then FOnMOuseDOwn(Self, Button, Shift, X,Y);
end;
{------------------------------------------------------------------------------}
@ -1170,7 +1169,7 @@ begin
FFont := TFont.Create;
//FFont.OnChange := @FontChanged;
FIsControl := False;
FEnabled := True; {Default}
end;
{------------------------------------------------------------------------------}
@ -1240,6 +1239,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:25 michael
+ Initial import

24
lcl/include/interfacebase.inc
View File

@ -79,9 +79,9 @@ begin
Result := False;
end;
Function TInterfacebase.DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean;
Begin
Result := False;
function TInterfacebase.DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean;
begin
Result := False;
end;
function TInterfaceBase.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean;
@ -89,11 +89,22 @@ Begin
Result := False;
end;
function TInterfaceBase.EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
Result := False;
end;
function TInterfaceBase.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
begin
Result := False;
end;
function TInterfaceBase.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
// Your default here
// Result :=
end;
function TInterfaceBase.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin
Result := False;
@ -365,6 +376,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:26 michael
+ Initial import

39
lcl/include/menuitem.inc
View File

@ -29,7 +29,7 @@ begin
FItems := nil;
FMenu := nil;
FParent := nil;
FShortCut := 0;
FShortCut := 0;
FChecked := False;
FVisible := True;
FEnabled := True;
@ -112,7 +112,7 @@ end;
------------------------------------------------------------------------------}
destructor TMenuItem.Destroy;
var
i : integer;
i : integer;
begin
i := 0;
if assigned (FItems) then
@ -346,12 +346,13 @@ end;
------------------------------------------------------------------------------}
procedure TMenuItem.SetEnabled(Value: Boolean);
begin
If FEnabled <> Value then
Begin
FEnabled := Value;
//TODO: this doesn't work. HAndle is 0. What's wrong?
InterfaceObject.IntSendMessage3(LM_SETENABLED,Self,nil);
End;
if FEnabled <> Value
then begin
FEnabled := Value;
// TODO, finish with correct params
// if HandleAllocated and (Parent <> nil)
// then EnableMenuItem(Parent.Handle, )
end;
//TODO: Add runtime code here
end;
@ -380,10 +381,10 @@ end;
Procedure TMenuItem.SetShortCut(Value : TShortCut);
Begin
if FShortCut <> Value then
Begin
FShortCut := Value;
MenuChanged(True); //Use this to do a sendmessage
End;
begin
FShortCut := Value;
MenuChanged(True); //Use this to do a sendmessage
end;
end;
{------------------------------------------------------------------------------
@ -403,6 +404,13 @@ end;
{ =============================================================================
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 19:01:33 lazarus
menus will be destroyed now, stoppok
@ -431,6 +439,13 @@ end;
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 19:01:33 lazarus
menus will be destroyed now, stoppok

25
lcl/include/pixmap.inc
View File

@ -16,6 +16,7 @@ type
PCharArray = ^TCharArray;
var
Buf: PCharArray;
BufPtr: ^PChar;
P: PChar;
S: TStringList;
n, BufIndex: Integer;
@ -30,24 +31,27 @@ begin
try
S.LoadFromStream(Stream);
Buf := GetMem(S.Count * SizeOf(PCharArray));
BufPtr := Pointer(Buf);
try
BufIndex := 0;
for n := 0 to S.Count - 1 do
if S.Strings[n][1] = '"'
then begin
Buf^[BufIndex] := @S.Strings[n][2];
P := StrScan(Buf^[BufIndex], '"');
//Debug info
p := @S.Strings[n][2];
//---
BufPtr^ := @S.Strings[n][2];
// Buf^[BufIndex] := @S.Strings[n][2];
P := StrScan(BufPtr^, '"');
// P := StrScan(Buf^[BufIndex], '"');
if p <> nil then p^ := #0;
Inc(BufIndex);
Inc(BufPtr);
// Inc(BufIndex);
end;
if FTransparentColor = clNone
then Handle := CreatePixmapIndirect(Buf, -1)
else Handle := CreatePixmapIndirect(Buf, ColorToRGB(FTransparentColor));
finally
{ Assert(False, 'Trace:*****************************************');
Assert(False, 'Trace:the buf is -');
for n := 0 to BufIndex-1 do
Assert(False, 'Trace:' + strpas(Buf^[n])); }
FreeMem(Buf);
end;
finally
@ -58,6 +62,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:27 michael
+ Initial import

17
lcl/include/winapi.inc
View File

@ -96,11 +96,21 @@ Begin
Result := InterfaceObject.DrawEdge(DC, Rect, edge, grfFlags);
end;
function EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
Result := InterfaceObject.EnableMenuItem(hMenu, uIDEnableItem, bEnable);
end;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
begin
Result := InterfaceObject.EnableScrollBar(Wnd, wSBflags, wArrows);
end;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
Result := InterfaceObject.EnableWindow(hWnd, bEnable);
end;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin
Result := InterfaceObject.ExtTextOut(DC, X, Y, Options, Rect, Str, Count, Dx);
@ -869,6 +879,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

9
lcl/include/winapih.inc
View File

@ -40,7 +40,9 @@ function DestroyCaret: Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
//function EqualRect --> independent
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -204,6 +206,13 @@ function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): Boolean
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

28
lcl/include/wincontrol.inc
View File

@ -1214,6 +1214,23 @@ begin
if Assigned(FOnExit) then FOnExit(Self);
end;
{------------------------------------------------------------------------------
Method: TWinControl.CMEnabledChanged
Params: Message
Returns: Nothing
Called when enabled is changed. Takes action to enable control
------------------------------------------------------------------------------}
procedure TWinControl.CMEnabledChanged(var Message: TLMEssage);
begin
if not Enabled and (Parent <> nil)
then RemoveFocus(False);
if HandleAllocated
and not (csDesigning in ComponentState)
then EnableWindow(FHandle, Enabled);
end;
{------------------------------------------------------------------------------
Method: TWinControl.WMSetFocus
Params: Message
@ -1573,6 +1590,8 @@ begin
CNSendMessage(LM_SETSIZE, Self, @R);
CNSendMessage(LM_SHOWHIDE, Self, nil);
CNSendMessage(LM_SETCOLOR, Self, nil);
EnableWindow(Handle, Enabled);
//We shouldn't NEED to create our own PCHAR. We should be able
//to typecast Caption as a PCHAR but it doesn't work.
@ -1583,7 +1602,7 @@ begin
finally
strDispose(pStr);
end;
Assert(False, 'Trace:SETPROP**********************************************');
Assert(False, 'Trace:SETPROP**********************************************');
SetProp(Handle,'WinControl',TWinControl(Self));
SetProp(Handle,'Control',TControl(Self));
@ -1838,6 +1857,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:28 michael
+ Initial import

24
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -73,15 +73,24 @@ begin
Result := DeliverMessage(Data, Mess) = 0;
end;
// TLMPaint = packed record
// Msg: Cardinal;
// DC: HDC;
// Unused: Longint;
// Result: Longint;
// end;
function gtkdraw( widget: PGtkWidget; area : PgdkRectangle; data: gPointer) : GBoolean; cdecl;
var
Mess : TLMessage;
MSG: TLMPaint;
begin
Result := True;
EventTrace('draw', data);
Mess.Msg := LM_PAINT;
Result := DeliverMessage(Data, Mess) = 0;
MSG.Msg := LM_PAINT;
// TODO: get DC
MSG.DC := 0;
MSG.Unused := 0;
Result := DeliverMessage(Data, MSG) = 0;
end;
function GTKDrawDefault(Widget: PGTKWidget; Data: gPointer): GBoolean; cdecl;
@ -1023,6 +1032,13 @@ end;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

14
lcl/interfaces/gtk/gtkint.pp
View File

@ -110,6 +110,13 @@ type
FGTKToolTips: PGtkToolTips;
FAccelGroup: PgtkAccelGroup;
FStockNullBrush: HBRUSH;
FStockBlackBrush: HBRUSH;
FStockLtGrayBrush: HBRUSH;
FStockGrayBrush: HBRUSH;
FStockDkGrayBrush: HBRUSH;
FStockWhiteBrush: HBRUSH;
procedure CreateComponent(Sender : TObject);
procedure AddChild(Parent,Child : Pointer; Left,Top: Integer);
procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);
@ -314,6 +321,13 @@ end.
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

296
lcl/interfaces/gtk/gtkobject.inc
View File

@ -115,6 +115,13 @@ begin
gtk_object_unref(PGTKObject(FGTKToolTips));
FGTKToolTips := nil;
DeleteObject(FStockNullBrush);
DeleteObject(FStockBlackBrush);
DeleteObject(FStockLtGrayBrush);
DeleteObject(FStockGrayBrush);
DeleteObject(FStockDkGrayBrush);
DeleteObject(FStockWhiteBrush);
gtk_main_quit;
end;
@ -126,6 +133,10 @@ end;
*Note: Initialite GTK engine
------------------------------------------------------------------------------}
procedure TGtkObject.Init;
var
LogBrush: TLogBrush;
Attributes: TGdkWindowAttr;
AttributesMask: gint;
begin
{ initialize app level gtk engine }
gtk_set_locale ();
@ -146,55 +157,29 @@ begin
FGTKToolTips := gtk_tooltips_new;
gtk_object_ref(PGTKObject(FGTKToolTips));
gtk_toolTips_Enable(FGTKToolTips);
//Init stock objects;
LogBrush.lbStyle := BS_NULL;
FStockNullBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbStyle := BS_SOLID;
LogBrush.lbColor := $000000;
FStockBlackBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $C0C0C0;
FStockLtGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $808080;
FStockGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $404040;
FStockDkGrayBrush := CreateBrushIndirect(LogBrush);
LogBrush.lbColor := $FFFFFF;
FStockWhiteBrush := CreateBrushIndirect(LogBrush);
end;
{------------------------------------------------------------------------------
Function: ObjectToGTKObject
Params: AObject: A LCL Object
Returns: The GTKObject of the given object
Returns the GTKObject of the given object, nil if no object available
------------------------------------------------------------------------------}
function ObjectToGTKObject(const AObject: TObject): gtk_object;
var
handle : HWND;
begin
if not assigned (AObject) then
begin
assert (false, 'TRACE: ObjectToGtkObject: object not assigned');
handle := 0
end
else if (AObject is TWinControl) then
begin
if TWinControl (AObject).HandleAllocated then handle := TWinControl(AObject).Handle
end
else if (AObject is TMenuItem) then
begin
if TMenuItem(AObject).HandleAllocated then handle := TMenuItem(AObject).Handle
end
else if (AObject is TMenu) then
begin
if TMenu(AObject).HandleAllocated then handle := TMenu(AObject).Items.Handle
end
else if (AObject is TCustomDialog) then
begin
{if TCustomDialog(AObject).HandleAllocated then } handle := TCustomDialog(AObject).Handle
end
else begin
Assert(False, 'Trace:Message received with unhandled class-type');
handle := 0;
end;
result := gtk_object (handle);
if handle = 0 then assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******');
end;
{------------------------------------------------------------------------------
Method: TGtkObject.IntSendMessage3
Params: LM_Message - message to be processed by GTK
Sender - sending control
data - pointer to (optional)
data - pointer to (optional)
Returns: depends on the message and the sender
Processes messages from different components.
@ -204,19 +189,19 @@ end;
------------------------------------------------------------------------------}
function TgtkObject.IntSendMessage3(LM_Message : Integer; Sender : TObject; data : pointer) : integer;
var
handle : hwnd; // handle of sender
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
AParent : TWinControl; // only used twice, replace with typecasts!
handle : hwnd; // handle of sender
pStr : PChar; // temporary string pointer, must be allocated/disposed when used!
Widget : PGtkWidget; // pointer to gtk-widget (local use when neccessary)
AParent : TWinControl; // only used twice, replace with typecasts!
Pixmap : pgdkPixMap;
box1 : pgtkWidget; // currently only used for TBitBtn
pixmapwid : pGtkWidget; // currently only used for TBitBtn, possibly replace with pixmap!!!!
pLabel : PgtkWidget; // currently only used as extra label-widget for TBitBtn
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
GList : pGList; // Only used for listboxes, replace with widget!!!!!
SelectionMode : TGtkSelectionMode; // currently only used for listboxes
ListItem : PGtkListItem; // currently only used for listboxes
box1 : pgtkWidget; // currently only used for TBitBtn
pixmapwid : pGtkWidget; // currently only used for TBitBtn, possibly replace with pixmap!!!!
pLabel : PgtkWidget; // currently only used as extra label-widget for TBitBtn
Num : Integer; // currently only used for LM_INSERTTOOLBUTTON
pStr2 : PChar; // currently only used for LM_INSERTTOOLBUTTON
GList : pGList; // Only used for listboxes, replace with widget!!!!!
SelectionMode : TGtkSelectionMode; // currently only used for listboxes
ListItem : PGtkListItem; // currently only used for listboxes
begin
result := 0; //default value just in case nothing sets it
@ -286,7 +271,7 @@ begin
LM_BTNDEFAULT_CHANGED :
Begin
if (TButton(Sender).Default) and (GTK_WIDGET_CAN_DEFAULT(pgtkwidget(handle)))
then gtk_widget_grab_default(pgtkwidget(handle))
then gtk_widget_grab_default(pgtkwidget(handle))
else gtk_widget_Draw_Default(pgtkwidget(Handle)); //this isn't right but I'm not sure what to call
end;
@ -297,10 +282,10 @@ begin
Assert(False, 'Trace:removing timer!!!');
gtk_timeout_remove((Sender as TTimer).TimerID);
end
else if (Sender is TWinControl) or (Sender is TCustomDialog)
else if (Sender is TWinControl) or (Sender is TCustomDialog)
then gtk_widget_destroy( PGtkWidget(Handle))
else
Assert (False, Format ('Trace:Dont know how to destroy component %s', [sender.classname]));
Assert (False, Format ('Trace:Dont know how to destroy component %s', [sender.classname]));
end;
LM_DRAGINFOCHANGED :
@ -310,43 +295,43 @@ begin
Begin
//drag and drop
gtk_drag_dest_set (p,
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_signal_connect( PgtkObject(p), 'drag_data_received',
TGTKSignalFunc( @edit_drag_data_received), Sender);
TGTKSignalFunc( @edit_drag_data_received), Sender);
gtk_drag_source_set (p, GDK_BUTTON1_MASK,
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_drag_source_set_icon (p,
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_get',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_delete',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
end
else
Begin
//drag and drop
gtk_drag_dest_set (p,
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
GTK_DEST_DEFAULT_ALL,
target_table, TargetEntrys - 1,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_signal_connect( PgtkObject(p), 'drag_data_received',
TGTKSignalFunc( @edit_drag_data_received), Sender);
TGTKSignalFunc( @edit_drag_data_received), Sender);
gtk_drag_source_set (p, GDK_BUTTON1_MASK,
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
target_table, TargetEntrys,
GDK_ACTION_COPY or GDK_ACTION_MOVE);
gtk_drag_source_set_icon (p,
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_widget_get_colormap (pgtkwidget(p)),
drag_icon, drag_mask);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_get',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
GTK_SIGNAL_FUNC (@Edit_source_drag_data_get), Sender);
gtk_signal_connect (GTK_OBJECT (p), 'drag_data_delete',
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
GTK_SIGNAL_FUNC (@Edit_source_drag_data_delete), Sender);
end;
*)
end;
@ -354,7 +339,7 @@ begin
//TBitBtn
LM_IMAGECHANGED, LM_LAYOUTCHANGED :
Begin
Assert(False, 'Trace:********************');
Assert(False, 'Trace:********************');
Assert(False, 'Trace:1');
box1 := gtk_object_get_data(pgtkObject(handle),'HBox');
if box1 <> nil then
@ -380,7 +365,7 @@ begin
pixmap := pgdkPixmap(PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapObject);
Assert(False, 'Trace:3');
if PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMaskObject <> nil
then pixmapwid := gtk_pixmap_new(pixmap,PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMAskObject)
then pixmapwid := gtk_pixmap_new(pixmap,PgdiObject(TBitBtn(Sender).Glyph.handle)^.GDIBitmapMAskObject)
else pixmapwid := gtk_pixmap_new(pixmap,nil);
Assert(False, 'Trace:4');
@ -409,7 +394,7 @@ begin
gtk_widget_show(pLabel);
gtk_container_add(PgtkContainer(handle),box1);
gtk_widget_show(box1);
Assert(False, 'Trace:********************');
Assert(False, 'Trace:********************');
end;
//SH: think of TBitmap.handle!!!!
@ -434,15 +419,6 @@ begin
else Result := -1;
end;
LM_SETENABLED:
begin
if (sender is TWincontrol)
then gtk_widget_set_sensitive(pgtkwidget(handle),TControl(sender).Enabled)
else if (sender is TMenuItem)
then gtk_widget_set_sensitive(pgtkwidget(handle),TMenuItem(sender).Enabled)
else Assert(False, 'Trace:***************NOT SUPPORTED*******************');
end;
LM_SETFILTER :
begin
pStr := StrAlloc(length(TFileDialog(Sender).Filter) + 1);
@ -471,8 +447,8 @@ begin
begin
if Sender is TCustomDialog then
begin
// Should be done elsewhere (eg via SetLabel) not here!
pStr:= StrAlloc(Length(TCustomDialog(Sender).Title) + 1);
// Should be done elsewhere (eg via SetLabel) not here!
pStr:= StrAlloc(Length(TCustomDialog(Sender).Title) + 1);
try
StrPCopy(pStr, TCustomDialog(Sender).Title);
gtk_window_set_title(PGtkWindow(handle), pStr);
@ -483,7 +459,7 @@ begin
gtk_window_set_position(PGtkWindow(handle), GTK_WIN_POS_CENTER);
gtk_widget_show(PGtkWidget(handle));
gtk_window_set_modal(PGtkWindow(handle), true);
{ Don't grab anything - this is done by gtk_window_set_modal }
{ Don't grab anything - this is done by gtk_window_set_modal }
//gtk_grab_add(PgtkWidget(Handle));
end;
@ -539,7 +515,7 @@ begin
pStr2 := StrAlloc(Length(tcontrol(Sender).Hint)+1);
StrPCopy(pStr2,tcontrol(Sender).Hint);
end
else Begin
else Begin
raise Exception.Create('Can not assign this control to the toolbar');
exit;
end;
@ -550,7 +526,7 @@ begin
{Make sure it's created!!}
if handle = 0
then IntSendMessage3(LM_CREATE,Sender,nil);
then IntSendMessage3(LM_CREATE,Sender,nil);
gtk_toolbar_insert_widget(pGTKToolbar(TWinControl(sender).parent.Handle),
pgtkwidget(handle),pstr,pStr2,Num);
@ -562,7 +538,7 @@ begin
LM_DELETETOOLBUTTON:
Begin
with pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^ do
children := g_list_remove(pgList(children), sender);
children := g_list_remove(pgList(children), sender);
// Next 3 lines: should be same as above, remove when above lines are proofed
// pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children :=
// g_list_remove(pgList(pgtkToolbar(TToolbar(TWinControl(Sender).parent).handle)^.children),
@ -592,7 +568,7 @@ begin
//Erase and then write over that section in the rect
PixMap := gtk_object_get_data(PgtkObject(Handle),'Pixmap');
if Assigned(PixMap) then
begin
begin
gdk_draw_rectangle(pixmap,GetPen(pixmap,TColortoTgdkColor(TCustomForm(Sender).Color)),1,TREct(data^).Left,TRect(data^).Top,TRect(Data^).Right-TRect(Data^).Left,TRect(Data^).Bottom-TRect(Data^).Top);
gtk_widget_queue_draw(PGtkWidget(Handle));
//The following should eventually be implemented. It's supposed
@ -602,7 +578,7 @@ begin
fWindow :pGdkWindow;
gc : pgdkGC;
widget := gtk_Object_get_data(pgtkobject(Handle),'Fixed');
widget := gtk_Object_get_data(pgtkobject(Handle),'Fixed');
fWindow := pGtkWidget(widget)^.window;
gc := gdk_gc_new(PgdkWindow(fWindow));
@ -651,7 +627,7 @@ begin
LM_GETTEXT :
begin
Assert (true, 'WARNING:[TgtkObject.IntSendMessage3] usage of LM_GETTEXT superfluous, use interface-function GetText instead');
Result := integer (nil);
Result := integer (nil);
end;
LM_GETITEMINDEX :
@ -664,11 +640,11 @@ begin
else begin
GList:= PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection;
if GList = nil
then Widget:= nil
then Widget:= nil
else Widget:= PGtkWidget(GList^.data);
end;
if Widget = nil
then Result:= -1
then Result:= -1
else Result:= gtk_list_child_position(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), Widget);
end;
csCListBox:
@ -749,7 +725,7 @@ begin
LM_GETSELCOUNT :
begin
case (Sender as TControl).fCompStyle of
csListBox : Result:= g_list_length(PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection);
csListBox : Result:= g_list_length(PGtkList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection);
csCListBox: Result:= g_list_length(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle)))^.selection);
end;
end;
@ -779,61 +755,61 @@ begin
LM_SETLIMITTEXT :
begin
if (Sender is TControl) and (TControl(Sender).fCompStyle = csComboBox)
then gtk_entry_set_max_length(PGtkEntry(PGtkCombo(Handle)^.entry), Integer(Data^));
then gtk_entry_set_max_length(PGtkEntry(PGtkCombo(Handle)^.entry), Integer(Data^));
end;
LM_SORT :
begin
if (Sender is TControl) and assigned (data) then
begin
case TControl(Sender).fCompStyle of
csComboBox,
csListBox : TGtkListStringList(TLMSort(Data^).List).Sorted:= TLMSort(Data^).IsSorted;
begin
case TControl(Sender).fCompStyle of
csComboBox,
csListBox : TGtkListStringList(TLMSort(Data^).List).Sorted:= TLMSort(Data^).IsSorted;
csCListBox : TGtkCListStringList(TLMSort(Data^).List).Sorted := TLMSort(Data^).IsSorted;
end
end
end
end
end;
LM_SETSEL :
begin
if (Sender is TControl) and
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
begin
if (TControl(Sender).fCompStyle = csListBox) then
begin
if TLMSetSel(Data^).Selected
then gtk_list_select_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), TLMSetSel(Data^).Index)
then gtk_list_select_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), TLMSetSel(Data^).Index)
else gtk_list_unselect_item(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), TLMSetSel(Data^).Index);
end
else if (TControl(Sender).fCompStyle = csCListBox) then
begin
begin
if TLMSetSel(Data^).Selected
then gtk_clist_select_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),TLMSetSel(Data^).Index,0)
then gtk_clist_select_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),TLMSetSel(Data^).Index,0)
else gtk_clist_unselect_row(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),TLMSetSel(Data^).Index,0);
end;
end;
end;
end;
LM_SETSELMODE :
begin
if (Sender is TControl) and
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
(TControl(Sender).fCompStyle in [csListBox, csCListBox]) and
assigned (data) then
begin
if TLMSetSelMode(Data^).MultiSelect then
begin
if TLMSetSelMode(Data^).ExtendedSelect
then SelectionMode:= GTK_SELECTION_EXTENDED
then SelectionMode:= GTK_SELECTION_EXTENDED
else SelectionMode:= GTK_SELECTION_MULTIPLE;
end
else
SelectionMode:= GTK_SELECTION_BROWSE;
case TControl(Sender).fCompStyle of
csListBox : gtk_list_set_selection_mode(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), SelectionMode);
csCListBox : gtk_clist_set_selection_mode(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),SelectionMode);
else
Assert (true, 'WARNING:[TgtkObject.IntSendMessage3] usage of LM_SETSELMODE unimplemented for actual component');
case TControl(Sender).fCompStyle of
csListBox : gtk_list_set_selection_mode(PGtkList(GetCoreChildWidget(PGtkWidget(Handle))), SelectionMode);
csCListBox : gtk_clist_set_selection_mode(PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),SelectionMode);
else
Assert (true, 'WARNING:[TgtkObject.IntSendMessage3] usage of LM_SETSELMODE unimplemented for actual component');
end;
end;
end;
@ -841,16 +817,16 @@ begin
LM_SETBORDER :
begin
if (Sender is TControl) then
begin
begin
if (TControl(Sender).fCompStyle = csListBox) then
begin
{ In TempWidget, a viewport is stored }
Widget:= PGtkWidget(PGtkBin(Handle)^.child);
if TListBox(Sender).BorderStyle = TBorderStyle(bsSingle)
then gtk_viewport_set_shadow_type(PGtkViewPort(Widget), GTK_SHADOW_IN)
then gtk_viewport_set_shadow_type(PGtkViewPort(Widget), GTK_SHADOW_IN)
else gtk_viewport_set_shadow_type(PGtkViewPort(Widget), GTK_SHADOW_NONE);
end
else if TControl(Sender).fCompStyle = csCListBox then
else if TControl(Sender).fCompStyle = csCListBox then
begin
if TListBox(Sender).BorderStyle = TBorderStyle(bsSingle)
then gtk_clist_set_shadow_type(
@ -860,7 +836,7 @@ begin
PGtkCList(GetCoreChildWidget(PGtkWidget(Handle))),
GTK_SHADOW_NONE);
end;
end;
end;
end;
else
@ -938,7 +914,7 @@ end;
Method: TGtkObject.AddChild
Params: parent -
child -
left, top -
left, top -
Returns: Nothing
*Note: Adds A Child to a Parent Widget
@ -965,7 +941,7 @@ end;
WARNING: This should possibly be merged with the SetLabel method!
It's only left in here for TStatusBar right now cause it
may be nice to use it with different panels.
may be nice to use it with different panels.
------------------------------------------------------------------------------}
procedure TgtkObject.SetText(Child, Data: Pointer);
type
@ -973,7 +949,7 @@ type
begin
case pMsg(Data)^.fCompStyle of
csStatusBar : gtk_statusbar_push(PGTKStatusBar(Child),pMsg(Data)^.Panel,pMsg(Data)^.Userdata);
else
else
writeln ('STOPPOK: [TGtkObject.SetText] Possible superfluous use of SetText, use SetLabel instead!');
end;
{STOPPOK: Code seems superfluous, see SetLabel instead
@ -984,7 +960,7 @@ var
csNotebook :
begin
writeln ('STOPPOK: [TGtkObject.SetText] Notebook: Why the hell are we getting here?');
pStr := StrAlloc(Length(TLMNotebookEvent(Data^).Str) + 1);
pStr := StrAlloc(Length(TLMNotebookEvent(Data^).Str) + 1);
StrPCopy(pStr, TLMNotebookEvent(Data^).Str);
gtk_notebook_set_tab_label_text(PGtkNotebook(TWinControl(TLMNotebookEvent(Data^).Parent).handle),
PGtkWidget(TWinControl(TLMNotebookEvent(Data^).Child).handle),
@ -1129,7 +1105,6 @@ begin
}
end;
{------------------------------------------------------------------------------
Function: TGTKObject.SetCallback
Params: Msg - message for which to set a callback
@ -1160,7 +1135,7 @@ procedure TGTKObject.SetCallback(Msg : LongInt; Sender : TObject);
begin
//look for realize handler
if (Id > 0) and
(Signal_ID = RealizeID) and
(Signal_ID = RealizeID) and
(Func = TGTKSignalFunc(@GTKRealizeCB))
then RealizeHandler := Handler;
@ -1473,22 +1448,22 @@ const
//unused: Tpixdata = Array[1..20] of String;
var
caption : string; // the caption of "Sender"
StrTemp : PChar; // same as "caption" but as PChar
TempWidget : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary
Adjustment: PGTKAdjustment; // currently only used for csFixed
caption : string; // the caption of "Sender"
StrTemp : PChar; // same as "caption" but as PChar
TempWidget : PGTKWidget; // pointer to gtk-widget (local use when neccessary)
p : pointer; // ptr to the newly created GtkWidget
CompStyle, // componentstyle (type) of GtkWidget which will be created
TempInt : Integer; // local use when neccessary
Adjustment: PGTKAdjustment; // currently only used for csFixed
// - for csBitBtn
box1 : pgtkWidget; // currently only used for TBitBtn
pixmap : pGdkPixMap; // TBitBtn - the default pixmap
pixmapwid : pGtkWidget; // currently only used for TBitBtn
mask : pGDKBitmap; // currently only used for TBitBtn
style : pgtkStyle; // currently only used for TBitBtn
label1 : pgtkwidget; // currently only used for TBitBtn
TempStr : String; // currently only used for TBitBtn to load default pixmap
pStr : PChar; // currently only used for TBitBtn to load default pixmap
box1 : pgtkWidget; // currently only used for TBitBtn
pixmap : pGdkPixMap; // TBitBtn - the default pixmap
pixmapwid : pGtkWidget; // currently only used for TBitBtn
mask : pGDKBitmap; // currently only used for TBitBtn
style : pgtkStyle; // currently only used for TBitBtn
label1 : pgtkwidget; // currently only used for TBitBtn
TempStr : String; // currently only used for TBitBtn to load default pixmap
pStr : PChar; // currently only used for TBitBtn to load default pixmap
begin
Assert(False, 'Trace:In CreateComponet');
@ -1513,12 +1488,12 @@ begin
else if (Sender is TTimer)
then CompStyle := csTimer;
// the following is for debug only
if caption = '' then caption := Sender.ClassName;
// the following is for debug only
if caption = '' then caption := Sender.ClassName;
Assert(False, 'Trace:----------------------Creating component in TgtkObject- STR = '+caption+'-');
Assert(False, 'Trace:----------------------Creating component in TgtkObject- STR = '+caption+'-');
// until here remove when debug not needed
// until here remove when debug not needed
if caption = '' then caption := 'Blank';
@ -1541,14 +1516,14 @@ begin
gtk_container_set_border_width(PgtkContainer(box1),2);
style := gtk_widget_get_style(pGTKWidget(p));
// is this neccessary?
TempStr := './images/menu.xpm';
// is this neccessary?
TempStr := './images/menu.xpm';
pStr := StrAlloc(length(TempStr) + 1);
StrPCopy(pStr, TempStr);
pixmap := gdk_pixmap_create_from_xpm(pgtkWidget(p)^.window, @Mask,
@style^.bg[GTK_STATE_NORMAL],pStr);
StrDispose(pStr);
pixmapwid := gtk_pixmap_new(pixmap,mask);
label1 := gtk_label_new(StrTemp);
@ -1708,8 +1683,8 @@ begin
//drag icons
if Drag_Icon = nil
then Drag_Icon := gdk_pixmap_colormap_create_from_xpm_d (nil, gtk_widget_get_colormap (p),
@Drag_Mask,
nil, @IMGDrag_Icon);
@Drag_Mask,
nil, @IMGDrag_Icon);
end;
csFrame :
@ -2646,6 +2621,13 @@ end;
{ =============================================================================
$Log$
Revision 1.5 2000/07/30 21:48:33 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.4 2000/07/23 18:59:35 lazarus
more cleanups, stoppok

48
lcl/interfaces/gtk/gtkproc.inc
View File

@ -472,6 +472,47 @@ begin
Result := TLMessage(Message).Result;
end;
{------------------------------------------------------------------------------
Function: ObjectToGTKObject
Params: AObject: A LCL Object
Returns: The GTKObject of the given object
Returns the GTKObject of the given object, nil if no object available
------------------------------------------------------------------------------}
function ObjectToGTKObject(const AObject: TObject): gtk_object;
var
handle : HWND;
begin
if not assigned (AObject) then
begin
assert (false, 'TRACE: ObjectToGtkObject: object not assigned');
handle := 0
end
else if (AObject is TWinControl) then
begin
if TWinControl (AObject).HandleAllocated then handle := TWinControl(AObject).Handle
end
else if (AObject is TMenuItem) then
begin
if TMenuItem(AObject).HandleAllocated then handle := TMenuItem(AObject).Handle
end
else if (AObject is TMenu) then
begin
if TMenu(AObject).HandleAllocated then handle := TMenu(AObject).Items.Handle
end
else if (AObject is TCustomDialog) then
begin
{if TCustomDialog(AObject).HandleAllocated then } handle := TCustomDialog(AObject).Handle
end
else begin
Assert(False, 'Trace:Message received with unhandled class-type');
handle := 0;
end;
result := gtk_object (handle);
if handle = 0 then assert (false, 'Trace: [ObjectToGtkObject]****** Warning: handle = 0 *******');
end;
(***********************************************************************
Widget member functions
************************************************************************)
@ -613,6 +654,13 @@ end;
{
$Log$
Revision 1.2 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:29 michael
+ Initial import

140
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -25,6 +25,9 @@ const
SAbort = 'Abort';
SRetry = 'Retry';
SIgnore = 'Ignore';
const
BOOL_TEXT: array[Boolean] of string = ('False', 'True');
//##apiwiz##sps## // Do not remove
@ -370,6 +373,9 @@ begin
Result := 0;
pNewDC := NewDC;
// dont copy
// In a compatible DC you have to select a bitmap into it
(*
if IsValidDC(DC)
then with PDeviceContext(DC)^ do
begin
@ -381,7 +387,9 @@ begin
// We can't do anything yet
// Wait till a bitmap get selected
end;
*)
// Maybe copy these ??
pNewDC^.CurrentFont := CreateDefaultFont;
pNewDC^.CurrentBrush := CreateDefaultBrush;
pNewDC^.CurrentPen := CreateDefaultPen;
@ -908,6 +916,18 @@ begin
end;
end;
{------------------------------------------------------------------------------
Function: EnableMenuItem
Params: hMenu:
uIDEnableItem:
Returns:
------------------------------------------------------------------------------}
function TGTKObject.EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean;
begin
// Your code here
end;
{------------------------------------------------------------------------------
Function: EnableScrollBar
Params: Wnd, wSBflags, wArrows
@ -922,6 +942,20 @@ begin
Result := False;
end;
{------------------------------------------------------------------------------
Function: EnableWindow
Params: hWnd:
bEnable:
Returns:
------------------------------------------------------------------------------}
function TGTKObject.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
Assert(False, Format('Trace:[TGTKObject.EnableWindow] hWnd: 0x%x, Enable: %s', [hwnd, BOOL_TEXT[bEnable]]));
if hWnd <> 0
then gtk_widget_set_sensitive(pgtkwidget(hWnd), bEnable)
end;
{------------------------------------------------------------------------------
Function: ExtTextOut
Params: none
@ -1323,8 +1357,59 @@ end;
------------------------------------------------------------------------------}
function TgtkObject.GetStockObject(Value: Integer): LongInt;
begin
Assert(False, 'Trace:TODO: [TgtkObject.GetStockObject]');
Assert(False, Format('Trace:[TgtkObject.GetStockObject] %d', [Value]));
Result := 0;
case Value of
BLACK_BRUSH: // Black brush.
Result := FStockBlackBrush;
DKGRAY_BRUSH: // Dark gray brush.
Result := FStockDKGrayBrush;
GRAY_BRUSH: // Gray brush.
Result := FStockGrayBrush;
LTGRAY_BRUSH: // Light gray brush.
Result := FStockLtGrayBrush;
NULL_BRUSH: // Null brush (equivalent to HOLLOW_BRUSH).
Result := FStockNullBrush;
WHITE_BRUSH: // White brush.
Result := FStockWhiteBrush;
(*
BLACK_PEN: // Black pen.
begin
end;
NULL_PEN: // Null pen.
begin
end;
WHITE_PEN: // White pen.
begin
end;
ANSI_FIXED_FONT: // Fixed-pitch (monospace) system font.
begin
end;
ANSI_VAR_FONT: // Variable-pitch (proportional space) system font.
begin
end;
DEVICE_DEFAULT_FONT: // Device-dependent font.
begin
end;
DEFAULT_GUI_FONT: // Default font for user interface objects such as menus and dialog boxes.
begin
end;
OEM_FIXED_FONT: // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font.
begin
end;
SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font.
begin
end;
SYSTEM_FIXED_FONT: // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows.
begin
end;
DEFAULT_PALETTE: // Default palette. This palette consists of the static colors in the system palette.
begin
end;
*)
else
Assert(False, Format('Trace:TODO: [TgtkObject.GetStockObject] Implement value: %d', [Value]));
end;
end;
{------------------------------------------------------------------------------
@ -1921,7 +2006,7 @@ var Dialog, ALabel : PGtkWidget;
{ If there is the Cancel button, allow the dialog to close }
if RetValue = IDCANCEL then begin
gtk_object_set_data(PGtkObject(Dialog), 'modal_result', Pointer(IDCANCEL));
end;
end;
gtk_object_set_data(PGtkObject(AButton), 'modal_result', Pointer(RetValue));
gtk_signal_connect(PGtkObject(AButton), 'clicked', TGtkSignalFunc(@MessageButtonClicked), @ADialogResult);
gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.action_area), AButton);
@ -1940,38 +2025,48 @@ begin
ALabel:= gtk_label_new(lpText);
gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.vbox), ALabel);
DialogType:= (uType and $0000000F);
if DialogType = MB_OKCANCEL then begin
if DialogType = MB_OKCANCEL
then begin
CreateButton(SOK, IDOK);
CreateButton(SCancel, IDCANCEL);
end else begin
if DialogType = MB_ABORTRETRYIGNORE then begin
end
else begin
if DialogType = MB_ABORTRETRYIGNORE
then begin
CreateButton(SAbort, IDABORT);
CreateButton(SRetry, IDRETRY);
CreateButton(SIgnore, IDIGNORE);
end else begin
if DialogType = MB_YESNOCANCEL then begin
end
else begin
if DialogType = MB_YESNOCANCEL
then begin
CreateButton(SYes, IDYES);
CreateButton(SNo, IDNO);
CreateButton(SCancel, IDCANCEL);
end else begin
if DialogType = MB_YESNO then begin
CreateButton(SNo, IDNO);
CreateButton(SCancel, IDCANCEL);
end
else begin
if DialogType = MB_YESNO
then begin
CreateButton(SYes, IDYES);
CreateButton(SNo, IDNO);
end else begin
if DialogType = MB_RETRYCANCEL then begin
CreateButton(SRetry, IDRETRY);
CreateButton(SCancel, IDCANCEL);
end else begin
CreateButton(SNo, IDNO);
end
else begin
if DialogType = MB_RETRYCANCEL
then begin
CreateButton(SRetry, IDRETRY);
CreateButton(SCancel, IDCANCEL);
end
else begin
{ We have no buttons to show. Create the default of OK button }
CreateButton(SOK, IDOK);
end;
end;
end;
end;
end;
end;
gtk_window_set_title(PGtkWindow(Dialog), lpCaption);
gtk_window_set_position(PGtkWindow(Dialog), GTK_WIN_POS_CENTER);
gtk_window_set_modal(PGtkWindow(Dialog), true);
gtk_window_set_modal(PGtkWindow(Dialog), true);
gtk_widget_show_all(Dialog);
while ADialogResult = 0 do begin
Application.ProcessMessages;
@ -2873,6 +2968,13 @@ end;
{ =============================================================================
$Log$
Revision 1.3 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 10:53:41 lazarus
workaround for possible compiler bug (KEYSTATE), stoppok

9
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -24,7 +24,9 @@ function DestroyCaret: Boolean; override;
Function DrawFrameControl(DC: HDC; var Rect : TRect; uType, uState : Cardinal) : Boolean; override;
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
function EnableMenuItem(hMenu: HMENU; uIDEnableItem: Integer; bEnable: Boolean): Boolean; override;
function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;
function EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean; override;
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
function FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean; override;
@ -91,6 +93,13 @@ Function WindowFromPoint(Point : TPoint) : HWND; override;
{ =============================================================================
$Log$
Revision 1.2 2000/07/30 21:48:34 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.1 2000/07/13 10:28:30 michael
+ Initial import

21
lcl/lmessages.pp
View File

@ -27,9 +27,10 @@ interface
uses Classes,vclGlobals,LCLLinux;
CONST
const
//Commands sent to the interface units
// Commands sent to the interface units
// add also a escription to a message at the end of this unit
LM_ComUser = $1000;
LM_Create = LM_ComUser+1;
LM_SetLabel = LM_ComUser+2;
@ -88,7 +89,7 @@ LM_LOADXPM = LM_ComUser+52;
LM_DRAGINFOCHANGED = LM_COMUSER+53;
LM_SETENABLED = LM_COMUSER+54;
//LM_SETENABLED = LM_COMUSER+54;
LM_BRINGTOFRONT = LM_COMUSER+55;
//end of messages that are sent to the interface
@ -728,6 +729,13 @@ begin
LM_INSERTTOOLBUTTON : Result :='LM_INSERTTOOLBUTTON';
LM_DELETETOOLBUTTON : Result :='LM_DELETETOOLBUTTON';
LM_SetCursor : Result :='LM_SetCursor ';
LM_IMAGECHANGED : Result :='LM_IMAGECHANGED ';
LM_LAYOUTCHANGED : Result :='LM_LAYOUTCHANGED ';
LM_BTNDEFAULT_CHANGED: Result :='LM_BTNDEFAULT_CHANGED';
LM_LOADXPM : Result :='LM_LOADXPM ';
LM_DRAGINFOCHANGED : Result :='LM_DRAGINFOCHANGED ';
// LM_SETENABLED : Result :='LM_SETENABLED ';
LM_BRINGTOFRONT : Result :='LM_BRINGTOFRONT ';
else
Result := Format('Unkown message 0x%x (%d)', [AMessage, AMessage]);
end;
@ -740,6 +748,13 @@ end.
{
$Log$
Revision 1.3 2000/07/30 21:48:32 lazarus
MWE:
= Moved ObjectToGTKObject to GTKProc unit
* Fixed array checking in LoadPixmap
= Moved LM_SETENABLED to API func EnableWindow and EnableMenuItem
~ Some cleanup
Revision 1.2 2000/07/23 10:49:47 lazarus
added text for LM_Destroy, stoppok