paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 15:14:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

applied implementation for LM_LB_GETINDEXAT from Vincent

Browse Source 
git-svn-id: trunk@4995 -
This commit is contained in:
mattias 2004-01-03 11:57:48 +00:00
parent 48b038f8e3
commit 87684017f2
15 changed files with 149 additions and 70 deletions

1
ide/buildlazdialog.pas
View File

@ -836,6 +836,7 @@ begin
with ItemsListBox do begin
Name:='ItemsListBox';
Parent:=Self;
Style:= lbOwnerDrawFixed;
OnMouseDown:=@ItemsListBoxMouseDown;
OnDrawItem:=@ItemsListBoxDrawItem;
ItemHeight:=ImageList.Height+6;

2
ideintf/objectinspector.pp
View File

@ -633,7 +633,7 @@ end;
procedure TOIPropertyGrid.SetSelections(
const NewSelections:TComponentSelectionList);
var a:integer;
var
CurRow:TOIPropertyGridRow;
OldSelectedRowPath:string;
begin

2
lcl/include/customlistbox.inc
View File

@ -448,7 +448,7 @@ function TCustomListBox.GetIndexAtY(Y: integer): integer;
begin
Result:=-1;
if (not HandleAllocated) then exit;
Result:=CNSendMessage(LM_LB_GETINDEXAT, Self, @Y);
Result:=GetListBoxIndexAtY(Self, Y);
end;

8
lcl/include/intfbaselcl.inc
View File

@ -159,6 +159,11 @@ begin
Result:=GetDC(WindowHandle);
end;
function TInterfaceBase.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := -1;
end;
function TInterfaceBase.GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
@ -469,6 +474,9 @@ end;
{ =============================================================================
$Log$
Revision 1.7 2004/01/03 11:57:47 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.6 2003/12/25 14:17:07 mattias
fixed many range check warnings

8
lcl/include/lclintf.inc
View File

@ -172,6 +172,11 @@ begin
Result := InterfaceObject.GetDeviceSize(DC,p);
end;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := InterfaceObject.GetListBoxIndexAtY(ListBox, y);
end;
function GetNotebookTabIndexAtPos(Handle: HWND;
const ClientPos: TPoint): integer;
begin
@ -448,6 +453,9 @@ end;
{ =============================================================================
$Log$
Revision 1.6 2004/01/03 11:57:47 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.5 2003/11/27 23:02:30 mattias
removed menutype.pas

4
lcl/include/lclintfh.inc
View File

@ -63,6 +63,7 @@ function GetCmdLineParamDescForInterface: string; {$IFDEF IF_BASE_MEMBER}virtual
function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromDevice(SrcDC: HDC; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetRawImageFromBitmap(SrcBitmap, SrcMaskBitmap: HBITMAP; const SrcRect: TRect; var NewRawImage: TRawImage): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -141,6 +142,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.6 2004/01/03 11:57:47 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.5 2003/11/27 23:02:30 mattias
removed menutype.pas

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

@ -225,7 +225,6 @@ type
// listbox
function GetTopIndex(Sender: TObject): integer;virtual;
function SetTopIndex(Sender: TObject; NewTopIndex: integer): integer;virtual;
function GetIndexAtY(Sender: TObject; PointerToY: Pointer): integer;virtual;
procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
MultiSelect, ExtendedSelect: boolean); virtual;
@ -410,6 +409,9 @@ end.
{ =============================================================================
$Log$
Revision 1.163 2004/01/03 11:57:47 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.162 2003/12/25 14:17:07 mattias
fixed many range check warnings

51
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -28,6 +28,54 @@
//##apiwiz##sps## // Do not remove
{------------------------------------------------------------------------------
Function: GetListBoxIndexAtY
Params: ListBox:
y:
Returns:
------------------------------------------------------------------------------}
function TGTKObject.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
{$IFdef GTK2}
begin
writeln('TODO: TgtkObject.GetListBoxIndexAtY');
end;
{$Else}
var
ScrolledWindow: PGtkScrolledWindow;
VertAdj: PGTKAdjustment;
AdjValue: integer;
ListWidget: PGtkList;
AWidget: PGtkWidget;
GListItem: PGList;
ListItemWidget: PGtkWidget;
begin
Result:=-1;
if not (ListBox is TCustomListbox) then exit;
if TCustomListbox(ListBox).FCompStyle in [csListBox, csCheckListBox] then begin
AWidget:=PGtkWidget(TCustomListbox(ListBox).Handle);
ListWidget:=PGtkList(GetWidgetInfo(AWidget, True)^.ImplementationWidget);
ScrolledWindow:=PGtkScrolledWindow(AWidget);
VertAdj:=gtk_scrolled_window_get_vadjustment(ScrolledWindow);
if VertAdj=nil then
AdjValue:=y
else
AdjValue:=round(VertAdj^.value)+y;
GListItem:=ListWidget^.children;
while GListItem<>nil do begin
inc(Result);
ListItemWidget:=PGtkWidget(GListItem^.data);
dec(AdjValue,ListItemWidget^.Allocation.Height);
if AdjValue<0 then exit;
GListItem:=GListItem^.next;
end;
Result:=-1;
end;
end;
{$EndIf}
{------------------------------------------------------------------------------
Function: LCLCheckMenuItem
Params: BaseMenuItem
@ -87,6 +135,9 @@ end;
{ =============================================================================
$Log$
Revision 1.5 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.4 2003/11/27 23:02:30 mattias
removed menutype.pas

4
lcl/interfaces/gtk/gtklclintfh.inc
View File

@ -30,6 +30,7 @@
}
//##apiwiz##sps## // Do not remove
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
function LclCheckMenuItem(BaseMenuItem: TComponent): Boolean; override;
function LclEnableMenuItem(BaseMenuItem: TComponent): Boolean; override;
@ -40,6 +41,9 @@ function LclEnableMenuItem(BaseMenuItem: TComponent): Boolean; override;
{ =============================================================================
$Log$
Revision 1.5 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.4 2003/11/27 23:02:30 mattias
removed menutype.pas

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

@ -2294,11 +2294,8 @@ end;
function TgtkObject.GetTopIndex(Sender: TObject): integer;
------------------------------------------------------------------------------}
function TgtkObject.GetTopIndex(Sender: TObject): integer;
var
y: Integer;
begin
y:=0;
Result:=GetIndexAtY(Sender,@y);
Result:=GetListBoxIndexAtY(Sender as TComponent,0);
end;
{------------------------------------------------------------------------------
@ -2350,54 +2347,6 @@ begin
end;
end;
{$EndIf}
{------------------------------------------------------------------------------
function TgtkObject.GetIndexAtY(Sender: TObject; PointerToY: Pointer): integer;
------------------------------------------------------------------------------}
function TgtkObject.GetIndexAtY(Sender: TObject; PointerToY: Pointer): integer;
{$IFdef GTK2}
begin
writeln('TODO: TgtkObject.GetIndexAtY');
end;
{$Else}
var
ScrolledWindow: PGtkScrolledWindow;
VertAdj: PGTKAdjustment;
AdjValue: integer;
ListWidget: PGtkList;
AWidget: PGtkWidget;
GListItem: PGList;
ListItemWidget: PGtkWidget;
Y: integer;
begin
Result:=-1;
if not (Sender is TWinControl) then exit;
Y:=PInteger(PointerToY)^;
case TWinControl(Sender).fCompStyle of
csListBox, csCheckListBox:
begin
AWidget:=PGtkWidget(TWinControl(Sender).Handle);
ListWidget:=PGtkList(GetWidgetInfo(AWidget, True)^.ImplementationWidget);
ScrolledWindow:=PGtkScrolledWindow(AWidget);
VertAdj:=gtk_scrolled_window_get_vadjustment(ScrolledWindow);
if VertAdj=nil then
AdjValue:=y
else
AdjValue:=round(VertAdj^.value)+y;
GListItem:=ListWidget^.children;
while GListItem<>nil do begin
inc(Result);
ListItemWidget:=PGtkWidget(GListItem^.data);
dec(AdjValue,ListItemWidget^.Allocation.Height);
if AdjValue<0 then exit;
GListItem:=GListItem^.next;
end;
Result:=-1;
end;
end;
end;
{$EndIf}
{------------------------------------------------------------------------------
procedure TgtkObject.SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
@ -2549,7 +2498,6 @@ begin
LM_LB_GETTOPINDEX: Result:=GetTopIndex(Sender);
LM_LB_SETTOPINDEX: Result:=SetTopIndex(Sender,integer(Data));
LM_LB_GETINDEXAT: Result:=GetIndexAtY(Sender,Data);
else
begin
@ -8469,6 +8417,9 @@ end;
{ =============================================================================
$Log$
Revision 1.444 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.443 2003/12/25 14:17:07 mattias
fixed many range check warnings

38
lcl/interfaces/win32/win32callback.inc
View File

@ -108,6 +108,7 @@ Var
LMMouseEvent: TLMMouseEvent; // used by WM_MOUSEWHEEL
LMMove: TLMMove; // used by WM_MOVE
LMNotify: TLMNotify; // used by WM_NOTIFY
DrawListItemStruct: TDrawListItemStruct; //used by WM_DRAWITEM
{$IFDEF VER1_1_MSG} // should be 'ifndef VER1_0' when we fix TMsgArray
List: TMsgArray;
C: Integer;
@ -378,6 +379,29 @@ Begin
LMessage.Msg := LM_DESTROY;
PostQuitMessage(0);
End;
WM_DRAWITEM:
Begin
GetChildOwnerObject(WParam);
if OwnerObject is TCustomListbox then begin
LMessage.Msg := LM_DRAWLISTITEM;
TLMDrawListItem(LMessage).DrawListItemStruct := @DrawListItemStruct;
with DrawListItemStruct do begin
ItemID := PDrawItemStruct(LParam)^.itemID;
Area := PDrawItemStruct(LParam)^.rcItem;
ItemState := TOwnerDrawState(PDrawItemStruct(LParam)^.itemState);
DC := PDrawItemStruct(LParam)^._hDC;
end;
end
else begin
with TLMDrawItems(LMessage) do
begin
Msg := LM_DRAWITEM;
Ctl := 0;
DrawItemStruct := PDrawItemStruct(LParam);
end;
WinProcess := false;
end;
End;
WM_ENABLE:
Begin
If WParam <> 0 Then
@ -714,17 +738,6 @@ Begin
LMessage.LParam := LParam;
LMessage.WParam := WParam;
End;
WM_DRAWITEM:
Begin
GetChildOwnerObject(WParam);
with TLMDrawItems(LMessage) do
begin
Msg := LM_DRAWITEM;
Ctl := 0;
DrawItemStruct := PDrawItemStruct(LParam);
end;
WinProcess := false;
End;
End;
If WinProcess Then
@ -918,6 +931,9 @@ end;
{
$Log$
Revision 1.84 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.83 2003/12/30 08:38:03 micha
enable selection of checklistbox items (from vincent)

21
lcl/interfaces/win32/win32lclintf.inc
View File

@ -28,6 +28,24 @@
//##apiwiz##sps## // Do not remove
{------------------------------------------------------------------------------
Function: GetListBoxIndexAtY
Params: ListBox:
y:
Returns:
------------------------------------------------------------------------------}
function TWin32Object.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer;
begin
Result := -1;
if ListBox is TCustomListBox then begin
Result := Windows.SendMessage(TCustomListBox(ListBox).Handle, LB_ITEMFROMPOINT, 0, MakeLParam(0,y));
if hi(Result)=0 then
Result := lo(Result)
else Result := -1;
end;
end;
{------------------------------------------------------------------------------
Function: LCLCheckMenuItem
Params: BaseMenuItem
@ -73,6 +91,9 @@ End;
{ =============================================================================
$Log$
Revision 1.5 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.4 2003/12/29 14:22:22 micha
fix a lot of range check errors win32

4
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -27,6 +27,7 @@
}
//##apiwiz##sps## // Do not remove
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
function LclCheckMenuItem(BaseMenuItem: TComponent): Boolean; override;
function LclEnableMenuItem(BaseMenuItem: TComponent): Boolean; override;
@ -37,6 +38,9 @@ function LclEnableMenuItem(BaseMenuItem: TComponent): Boolean; override;
{ =============================================================================
$Log$
Revision 1.4 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.3 2003/11/27 23:02:30 mattias
removed menutype.pas

9
lcl/interfaces/win32/win32object.inc
View File

@ -1956,7 +1956,11 @@ Begin
else
Flags:= Flags or LBS_MULTIPLESEL;
if CompStyle = csCheckListBox then
Flags := Flags or LBS_OWNERDRAWFIXED;
Flags := Flags or LBS_OWNERDRAWFIXED
else case Style of
lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED;
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
end;
end;
FlagsEx := WS_EX_CLIENTEDGE;
pClassName := 'LISTBOX';
@ -2900,6 +2904,9 @@ End;
{
$Log$
Revision 1.156 2004/01/03 11:57:48 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.155 2003/12/29 21:56:08 micha
fix menuitem icon and index (from martin)

6
lcl/lmessages.pp
View File

@ -150,8 +150,7 @@ const
LM_LB_First = LM_NB_Last +1;
LM_LB_GETTOPINDEX = LM_LB_First +0;
LM_LB_SETTOPINDEX = LM_LB_First +1;
LM_LB_GETINDEXAT = LM_LB_First +2;
LM_LB_Last = LM_LB_GETINDEXAT;
LM_LB_Last = LM_LB_SETTOPINDEX;
// TCheckListBox
LM_CLB_FIRST = LM_LB_Last + 1;
@ -1093,6 +1092,9 @@ end.
{
$Log$
Revision 1.59 2004/01/03 11:57:47 mattias
applied implementation for LM_LB_GETINDEXAT from Vincent
Revision 1.58 2003/12/29 14:22:22 micha
fix a lot of range check errors win32