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

* Started to move TListview to the WS interface

Browse Source 
git-svn-id: trunk@5483 -
This commit is contained in:
marc 2004-05-18 23:10:41 +00:00
parent ba6baf4a88
commit ae6aebdfa7
9 changed files with 399 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
examples/listviewtest.pp
View File

@ -35,7 +35,7 @@ program ListViewTest;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
uses uses
Interfaces, Classes, Buttons, ComCtrls, Forms, SysUtils; Interfaces, Classes, Buttons, Controls, ComCtrls, Forms, SysUtils, StdCtrls;
type type
TMyForm = class(TForm) TMyForm = class(TForm)
@ -44,8 +44,14 @@ type
public public
ListView: TListView; ListView: TListView;
Button1: TButton; Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Button1Click(Sender: TObject); procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
end; end;
var var
@ -56,21 +62,27 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
Caption := 'List View Test'; Caption := 'List View Test';
Width := 175; Width := 300;
Height := 195; Height := 200;
ListView := TListView.Create(Self); ListView := TListView.Create(Self);
ListView.Parent := Self; ListView.Parent := Self;
ListView.Height := 120; ListView.Height := 150;
ListView.Width := 150; // ListView.Width := 250;
ListView.Align := alTop;
ListView.ViewStyle := vsReport;
ListView.Show; ListView.Show;
ListView.Columns.Add.Caption := 'Column 1';
ListView.Columns.Add.Caption := 'Column 2';
ListView.Columns.Add.Caption := 'Column 3';
Button1 := TButton.Create(Self); Button1 := TButton.Create(Self);
with Button1 do with Button1 do
begin begin
Parent := Self; Parent := Self;
Caption := 'Add Item'; Caption := 'Add Item';
Top := 130; Top := 160;
Left := 10; Left := 10;
Height := 25; Height := 25;
Width := 65; Width := 65;
@ -78,6 +90,43 @@ begin
Show; Show;
end; end;
Button2 := TButton.Create(Self);
with Button2 do
begin
Parent := Self;
Caption := 'Del Item';
Top := 160;
Left := 80;
Height := 25;
Width := 65;
OnClick := @Button2Click;
Show;
end;
Edit1 := TEdit.Create(Self);
with Edit1 do
begin
Parent := Self;
Top := 160;
Left := 150;
Height := 25;
Width := 65;
OnChange := @Edit1Change;
Show;
end;
Edit2 := TEdit.Create(Self);
with Edit2 do
begin
Parent := Self;
Top := 160;
Left := 220;
Height := 25;
Width := 65;
OnChange := @Edit2Change;
Show;
end;
Show; Show;
end; end;
@ -87,7 +136,26 @@ var
begin begin
Inc(FItemIndex); Inc(FItemIndex);
Item := ListView.Items.Add; Item := ListView.Items.Add;
Item.Caption := Format('Item %D', [FItemIndex]); Item.Caption := Format('Item %d', [FItemIndex]);
Item.SubItems.Add(Format('Sub %d.1', [FItemIndex]));
Item.SubItems.Add(Format('Sub %d.2', [FItemIndex]));
end;
procedure TMyForm.Button2Click(Sender: TObject);
begin
ListView.Selected.Free;
end;
procedure TMyForm.Edit1Change(Sender: TObject);
begin
if ListView.Selected = nil then Exit;
ListView.Selected.Caption := Edit1.Text;
end;
procedure TMyForm.Edit2Change(Sender: TObject);
begin
if ListView.Selected = nil then Exit;
ListView.Selected.SubItems[1] := Edit2.Text;
end; end;
begin begin
@ -98,6 +166,9 @@ end.
{ {
$Log$ $Log$
Revision 1.5 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.4 2002/10/29 08:22:32 lazarus Revision 1.4 2002/10/29 08:22:32 lazarus
MG: added interfaces unit MG: added interfaces unit

9
lcl/buttons.pp
View File

@ -296,13 +296,7 @@ implementation
uses uses
WSButtons; WSButtons;
const const
{BitbtnCaption : array[TBitBtnKind] of String = (
'', rsmbOK, rsmbCancel, rsmbHelp, rsmbYes, rsmbNo,
rsmbClose, rsmbAbort, rsmbRetry, rsmbIgnore, rsmbAll,
rsmbNoToAll, rsmbYesToAll);}
BitBtnModalResults : array[TBitBtnKind] of TModalResult = ( BitBtnModalResults : array[TBitBtnKind] of TModalResult = (
0, mrOK, mrCancel, 0, mrYes, mrNo, 0, mrOK, mrCancel, 0, mrYes, mrNo,
0, mrAbort, mrRetry, mrIgnore, mrAll, 0, mrAbort, mrRetry, mrIgnore, mrAll,
@ -334,6 +328,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.66 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.65 2004/05/16 23:24:41 marc Revision 1.65 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface + Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk + Implemented WSBitBtn interface for gtk

19
lcl/comctrls.pp
View File

@ -314,7 +314,7 @@ type
property Data: Pointer read FData write SetData; property Data: Pointer read FData write SetData;
property DropTarget: Boolean index 1 read GetState write SetState; property DropTarget: Boolean index 1 read GetState write SetState;
property Focused: Boolean index 2 read GetState write SetState; property Focused: Boolean index 2 read GetState write SetState;
property Index : Integer read GetIndex; property Index: Integer read GetIndex;
property ImageIndex : Integer read FImageIndex write SetImageIndex default -1; property ImageIndex : Integer read FImageIndex write SetImageIndex default -1;
property Owner : TListItems read FOwner; property Owner : TListItems read FOwner;
property Selected: Boolean index 3 read GetState write SetState; property Selected: Boolean index 3 read GetState write SetState;
@ -486,6 +486,12 @@ type
procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY; procedure CNNotify(var AMessage: TLMNotify); message CN_NOTIFY;
procedure DoUpdate; procedure DoUpdate;
procedure UpdateProperties; procedure UpdateProperties;
protected
//called by TListItems
procedure ItemChanged(const AItem: TListItem; const AIndex : Integer);
procedure ItemDeleted(const AIndex: Integer);
procedure ItemInserted(const AItem: TListItem; const AIndex: Integer);
protected protected
procedure InitializeWnd; override; procedure InitializeWnd; override;
procedure Loaded; override; procedure Loaded; override;
@ -499,10 +505,7 @@ type
function GetMaxScrolledLeft : Integer; function GetMaxScrolledLeft : Integer;
function GetMaxScrolledTop : Integer; function GetMaxScrolledTop : Integer;
procedure ColumnsChanged; //called by TListColumns procedure ColumnsChanged; //called by TListColumns
procedure ItemChanged(Index : Integer); //called by TListItems
procedure ItemDeleted(Index : Integer); //called by TListItems
procedure ImageChanged(Sender : TObject); procedure ImageChanged(Sender : TObject);
procedure ItemAdded(Index: Integer); //called by TListItems
procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL; procedure WMHScroll(var Msg: TLMScroll); message LM_HSCROLL;
procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL; procedure WMVScroll(var Msg: TLMScroll); message LM_VSCROLL;
// property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; // property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
@ -2201,7 +2204,10 @@ procedure CheckCommonControl(CC: Integer);
procedure Register; procedure Register;
Implementation implementation
uses
WSComCtrls;
const const
ScrollBarWidth=0; ScrollBarWidth=0;
@ -2249,6 +2255,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.123 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.122 2004/05/11 09:49:46 mattias Revision 1.122 2004/05/11 09:49:46 mattias
started sending CN_KEYUP started sending CN_KEYUP

43
lcl/include/customlistview.inc
View File

@ -167,8 +167,8 @@ procedure TCustomListView.InitializeWnd;
begin begin
inherited InitializeWnd; inherited InitializeWnd;
CNSendMessage(LM_SETPROPERTIES,Self,nil); CNSendMessage(LM_SETPROPERTIES,Self,nil);
if FSelected<>nil then if FSelected <> nil
CNSendMessage(LM_LV_SELECTITEM,Self,FSelected); then TWSCustomListViewClass(WidgetSetClass).SelectItem(Self, FSelected);
end; end;
procedure TCustomListView.Loaded; procedure TCustomListView.Loaded;
@ -197,7 +197,7 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomListView ItemChanged } { TCustomListView ItemChanged }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomListView.ItemChanged(Index : Integer); //called by TListItems procedure TCustomListView.ItemChanged(const AItem: TListItem; const AIndex: Integer); //called by TListItems
Begin Begin
if csDestroying in Componentstate Then Exit; if csDestroying in Componentstate Then Exit;
if FUpdateCount>0 then if FUpdateCount>0 then
@ -205,39 +205,40 @@ Begin
else begin else begin
//notify the interface.... //notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit; if (not HandleAllocated) or (csLoading in ComponentState) then exit;
CNSendMessage(LM_LV_CHANGEITEM,self,@Index); TWSCustomListViewClass(WidgetSetClass).ChangeItem(Self, AIndex, AItem);
end; end;
End; End;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomListView ItemDeleted } { TCustomListView ItemDeleted }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomListView.ItemDeleted(Index : Integer); //called by TListItems procedure TCustomListView.ItemDeleted(const AIndex : Integer); //called by TListItems
Begin begin
if csDestroying in Componentstate Then Exit; if csDestroying in Componentstate Then Exit;
if FSelected= FListItems[Index] then FSelected:=nil; if FSelected = FListItems[AIndex] then FSelected := nil;
DoDeletion(FListItems[Index]); DoDeletion(FListItems[AIndex]);
if FUpdateCount>0 then if FUpdateCount>0 then
Include(FStates,lvUpdateNeeded) Include(FStates,lvUpdateNeeded)
else begin else begin
//notify the interface.... //notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit; if (not HandleAllocated) or (csLoading in ComponentState) then Exit;
CNSendMessage(LM_LV_DELETEITEM,self,@Index); TWSCustomListViewClass(WidgetSetClass).DeleteItem(Self, AIndex);
end; end;
End; End;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomListView ItemAdded } { TCustomListView ItemInserted }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TCustomListView.ItemAdded(Index: Integer); procedure TCustomListView.ItemInserted(const AItem: TListItem; const AIndex: Integer);
Begin begin
if csDestroying in Componentstate Then Exit; if csDestroying in Componentstate Then Exit;
if FUpdateCount>0 then if FUpdateCount > 0
then
Include(FStates,lvUpdateNeeded) Include(FStates,lvUpdateNeeded)
else begin else begin
//notify the interface.... //notify the interface....
if (not HandleAllocated) or (csLoading in ComponentState) then exit; if (not HandleAllocated) or (csLoading in ComponentState) then Exit;
CNSendMessage(LM_LV_ADDITEM,self,@Index); TWSCustomListViewClass(WidgetSetClass).InsertItem(Self, AIndex, AItem);
end; end;
End; End;
@ -247,13 +248,14 @@ End;
procedure TCustomListView.SetItems(const AValue : TListItems); procedure TCustomListView.SetItems(const AValue : TListItems);
begin begin
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomListView SetItemVisible } { TCustomListView SetItemVisible }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
procedure TCustomListView.SetItemVisible(const AValue : TListItem); procedure TCustomListView.SetItemVisible(const AValue : TListItem);
begin begin
if (not HandleAllocated) or (csLoading in ComponentState) then exit; if (not HandleAllocated) or (csLoading in ComponentState) then exit;
CNSendMessage(LM_LV_SHOWITEM,self,AValue); TWSCustomListViewClass(WidgetSetClass).ShowItem(Self, AValue);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ TCustomListView Delete } { TCustomListView Delete }
@ -411,7 +413,9 @@ begin
if FSelected=AValue then exit; if FSelected=AValue then exit;
FSelected := AValue; FSelected := AValue;
if (not HandleAllocated) or (csLoading in ComponentState) then exit; if (not HandleAllocated) or (csLoading in ComponentState) then exit;
CNSendMessage(LM_LV_SELECTITEM,self,FSelected);
TWSCustomListViewClass(WidgetSetClass).SelectItem(Self, FSelected);
//DoSelectItem(FSelected, True); //DoSelectItem(FSelected, True);
end; end;
@ -614,6 +618,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.35 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.34 2004/05/11 12:16:47 mattias Revision 1.34 2004/05/11 12:16:47 mattias
replaced writeln by debugln replaced writeln by debugln

38
lcl/include/listitems.inc
View File

@ -38,9 +38,9 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
function TListItems.GetItem(const AIndex: Integer): TListItem; function TListItems.GetItem(const AIndex: Integer): TListItem;
begin begin
Result:=nil; if FItems.Count - 1 < AIndex
if (FItems.Count-1 < AIndex) then Exit; then Result := nil
Result := TListItem(FItems.Items[AIndex]); else Result := TListItem(FItems.Items[AIndex]);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -48,9 +48,9 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
procedure TListItems.SetItem(const AIndex: Integer; const AValue: TListItem); procedure TListItems.SetItem(const AIndex: Integer; const AValue: TListItem);
begin begin
if FItems.Count-1 < AIndex then Exit; if FItems.Count - 1 < AIndex then Exit;
FItems.Items[AIndex] := AValue; FItems.Items[AIndex] := AValue;
FOwner.ItemChanged(AIndex); FOwner.ItemChanged(AValue, AIndex);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -61,7 +61,8 @@ begin
Result := TListItem.Create(self); Result := TListItem.Create(self);
FItems.Add(Result); FItems.Add(Result);
//Notify parent TListView that something was added. //Notify parent TListView that something was added.
FOwner.ItemAdded(-1); if FOwner <> nil
then FOwner.ItemInserted(Result, -1);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -88,7 +89,7 @@ var
idx: Integer; idx: Integer;
begin begin
idx := FItems.IndexOf(AItem); idx := FItems.IndexOf(AItem);
if assigned(FOwner) if FOwner <> nil
then FOwner.ItemDeleted(idx); then FOwner.ItemDeleted(idx);
FItems.Remove(AItem); FItems.Remove(AItem);
end; end;
@ -101,8 +102,7 @@ begin
Result := TListItem.Create(self); Result := TListItem.Create(self);
FItems.Insert(AIndex, Result); FItems.Insert(AIndex, Result);
//Notify parent TListView that something was added. //Notify parent TListView that something was added.
FOwner.ItemAdded(AIndex); FOwner.ItemInserted(Result, AIndex);
end; end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -137,13 +137,12 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
Procedure TListItems.ItemChanged(Sender : TObject); //called by the onchange of the tstringlist in TListItem Procedure TListItems.ItemChanged(Sender : TObject); //called by the onchange of the tstringlist in TListItem
var var
Index : Integer; idx : Integer;
begin begin
// Writeln('ITEM CHANGED'); idx := FItems.IndexOf(sender);
Index := FItems.IndexOf(TListItem(sender)); if idx >= 0
// Writeln('Calling Item Changed with Index ',Index); then FOwner.ItemChanged(TListItem(Sender), idx)
if Index > -1 then else DebugLN('TListItems.ItemChanged for unknown item');
FOwner.ItemChanged(Index);
end; end;
procedure TListItems.DefineProperties(Filer: TFiler); procedure TListItems.DefineProperties(Filer: TFiler);
@ -250,8 +249,10 @@ begin
FreeMem(ItemHeader, Size); FreeMem(ItemHeader, Size);
Owner.EndUpdate; Owner.EndUpdate;
if Flag then // MWE: Still needed ???
Owner.ItemAdded(-1); // ENdUpdate already added all items.
//if Flag then
// Owner.ItemAdded(-1);
end; end;
end; end;
@ -332,6 +333,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.20 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.19 2004/04/10 17:58:57 mattias Revision 1.19 2004/04/10 17:58:57 mattias
implemented mainunit hints for include files implemented mainunit hints for include files

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

@ -230,10 +230,6 @@ type
procedure RemoveNBPage(ANoteBook: TObject; Index: Integer);virtual; procedure RemoveNBPage(ANoteBook: TObject; Index: Integer);virtual;
procedure MoveNBPage(ANoteBook, APage: TObject; NewIndex: Integer);virtual; procedure MoveNBPage(ANoteBook, APage: TObject; NewIndex: Integer);virtual;
// listview
procedure ListViewChangeItem(TheListView: TObject; Index: integer);
procedure ListViewAddItem(TheListView: TObject; Index: Integer);
// listbox // listbox
function GetTopIndex(Sender: TObject): integer;virtual; function GetTopIndex(Sender: TObject): integer;virtual;
function SetTopIndex(Sender: TObject; NewTopIndex: integer): integer;virtual; function SetTopIndex(Sender: TObject; NewTopIndex: integer): integer;virtual;
@ -344,7 +340,7 @@ uses
// GtkWSCalendar, // GtkWSCalendar,
// GtkWSCheckLst, // GtkWSCheckLst,
// GtkWSCListBox, // GtkWSCListBox,
// GtkWSComCtrls, GtkWSComCtrls,
GtkWSControls, GtkWSControls,
// GtkWSDbCtrls, // GtkWSDbCtrls,
// GtkWSDBGrids, // GtkWSDBGrids,
@ -464,6 +460,9 @@ end.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.182 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.181 2004/04/18 23:55:39 marc Revision 1.181 2004/04/18 23:55:39 marc
* Applied patch from Ladislav Michl * Applied patch from Ladislav Michl
* Changed the way TControl.Text is resolved * Changed the way TControl.Text is resolved

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

@ -2914,96 +2914,6 @@ begin
gdk_pixmap_unref(TempMaskPixmap); gdk_pixmap_unref(TempMaskPixmap);
end; end;
procedure TGtkWidgetSet.ListViewChangeItem(TheListView: TObject; Index: integer);
{$IfDef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.ListViewChangeItem');
end;
{$Else}
var
ListView: TListView;
LVWidget: PgtkCList;
pStr: PChar;
ListItem: TListItem;
i, ColCount: integer;
Pixmap: PGdkPixmap;
Mask: PGdkBitmap;
ImageBitmap, MaskBitmap: TBitmap;
ImageRect: TRect;
begin
ListView:=TListView(TheListView);
LVWidget:= PgtkCList(
GetWidgetInfo(Pointer(ListView.Handle), True)^.CoreWidget);
ListItem := ListView.Items[Index];
// set caption (= first column text)
pStr:=PChar(ListItem.Caption);
if pStr=nil then pStr:=#0;
gtk_clist_set_text(LVWidget,Index,0,pStr);
// set image
if (ListView.SmallImages <> nil) and (ListItem.ImageIndex >= 0)
and (ListItem.ImageIndex < Listview.SmallImages.Count)
then begin
//draw image
ListView.SmallImages.GetInternalImage(ListItem.ImageIndex,
ImageBitmap, MaskBitmap, ImageRect);
if (ImageRect.Left<>0) or (ImageRect.Top<>0) then
DebugLn('WARNING: TGtkWidgetSet.ListViewChangeItem does not support combined imagelists');
Pixmap:=PgdiObject(ImageBitmap.Handle)^.GDIPixmapObject;
Mask:=pgdkBitmap(PgdiObject(ImageBitmap.Handle)^.GDIBitmapMaskObject);
gtk_clist_set_pixtext(LVWidget,Index,0,pStr,3,Pixmap,Mask);
end;
// set the other column texts
ColCount:=LVWidget^.Columns;
for i := 1 to ColCount-1 do
begin
if i<=ListItem.SubItems.Count then begin
// the first subitem is the second column
pStr:=PChar(ListItem.SubItems.Strings[i-1]);
if pStr=nil then pStr:=#0;
end else begin
pStr:=#0
end;
gtk_clist_set_text(LVWidget,Index,i,pStr);
end;
end;
{$EndIf}
{------------------------------------------------------------------------------
procedure TGtkWidgetSet.ListViewAddItem(TheListView: TObject;Index: Integer);
------------------------------------------------------------------------------}
procedure TGtkWidgetSet.ListViewAddItem(TheListView: TObject; Index: Integer);
{$IfDef GTK2}
begin
DebugLn('TODO: TGtkWidgetSet.ListViewAddItem');
end;
{$Else}
var
ListView: TListView;
ListViewWidget: PGtkCList;
Titles: PPGChar;
i, Count: integer;
begin
ListView:=TListView(TheListView);
ListViewWidget:= PGtkCList(GetWidgetInfo(
Pointer(ListView.Handle), True)^.CoreWidget);
Count:=ListViewWidget^.columns;
if Count=0 then begin
DebugLn('WARNING: TGtkWidgetSet.ListViewAddItem ListViewWidget^.columns=0');
exit;
end;
GetMem(Titles,SizeOf(PGChar)*Count);
Titles[0]:=#0;
for i:=1 to Count-1 do Titles[i]:=nil;
if Index = -1 then
gtk_clist_append(ListViewWidget,Titles)
else
gtk_clist_insert(ListViewWidget,Index,Titles);
FreeMem(Titles);
end;
{$EndIf}
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
function TGtkWidgetSet.GetTopIndex(Sender: TObject): integer; function TGtkWidgetSet.GetTopIndex(Sender: TObject): integer;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
@ -3231,70 +3141,36 @@ begin
end; end;
end; end;
LM_LV_DELETEITEM : LM_LV_DELETEITEM:
begin
if (Sender is TListView) then
begin
{$IfDef GTK2} {$IfDef GTK2}
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_DELETEITEM'); DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_DELETEITEM');
{$Else} {$Else}
Num := Integer(data^); DebugLn('[WARNING] Obsolete messagecall to LM_LV_DELETEITEM for ', Sender.ClassName);
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
gtk_clist_remove(PgtkCList(Widget),Num);
{$EndIf} {$EndIf}
end;
end;
LM_LV_CHANGEITEM : LM_LV_CHANGEITEM:
if (Sender is TListView) then {$IfDef GTK2}
ListViewChangeItem(Sender,Integer(data^)); DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_CHANGEITEM');
{$Else}
DebugLn('[WARNING] Obsolete messagecall to LM_LV_CHANGEITEM for ', Sender.ClassName);
{$EndIf}
LM_LV_ADDITEM : LM_LV_ADDITEM:
if (Sender is TListView) then {$IfDef GTK2}
begin DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_ADDITEM');
if data <> nil then begin {$Else}
if Integer(data^) < 0 then begin DebugLn('[WARNING] Obsolete messagecall to LM_LV_ADDITEM for ', Sender.ClassName);
ListViewAddItem(Sender, -1); {$EndIf}
ListViewChangeItem(Sender,TListView(Sender).Items.Count-1);
end
else begin
ListViewAddItem(Sender,Integer(data^));
ListViewChangeItem(Sender,Integer(data^));
end;
end
else begin
ListViewAddItem(Sender,-1);
ListViewChangeItem(Sender,TListView(Sender).Items.Count-1);
end;
end;
LM_LV_SELECTITEM: LM_LV_SELECTITEM:
if (Sender is TListView) then
begin
{$IfDef GTK2} {$IfDef GTK2}
DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_SELECTITEM'); DebugLn('TODO: TGtkWidgetSet.IntSendMessage3 LM_LV_SELECTITEM');
{$Else} {$Else}
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget; DebugLn('[WARNING] Obsolete messagecall to LM_LV_SELECTITEM for ', Sender.ClassName);
gtk_clist_unselect_all(PGtkCList(Widget));
if Data<>nil then
gtk_clist_select_row(PGtkCList(Widget),TListItem(Data).Index,0);
{$EndIf} {$EndIf}
end;
LM_LV_SHOWITEM:
if (Sender is TListView) then
begin
if Data<>nil
then begin
Widget:= GetWidgetInfo(Pointer(Handle), True)^.CoreWidget;
//0=NotVisible
//1=PartiallyVisible
//2=Fully Visible
if gtk_clist_row_is_visible(PGtkCList(Widget),
TListItem(Data).Index) < 2
then gtk_clist_moveto(PGtkCList(Widget),TListItem(Data).Index,0,1,0);
end; LM_LV_SHOWITEM:
end; DebugLn('[WARNING] Obsolete messagecall to LM_LV_SHOWITEM for ', Sender.ClassName);
LM_BRINGTOFRONT: LM_BRINGTOFRONT:
begin begin
@ -9323,6 +9199,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.503 2004/05/18 23:10:41 marc
* Started to move TListview to the WS interface
Revision 1.502 2004/05/16 23:24:41 marc Revision 1.502 2004/05/16 23:24:41 marc
+ Added WSBitBtn interface + Added WSBitBtn interface
+ Implemented WSBitBtn interface for gtk + Implemented WSBitBtn interface for gtk

200
lcl/interfaces/gtk/gtkwscomctrls.pp
View File

@ -27,15 +27,19 @@ unit GtkWSComCtrls;
interface interface
uses uses
//////////////////////////////////////////////////// // libs
// I M P O R T A N T {$IFDEF GTK2}
//////////////////////////////////////////////////// GLib2, Gtk2,
// To get as little as posible circles, {$ELSE}
// uncomment only when needed for registration GLib, Gtk, Gdk,
//////////////////////////////////////////////////// {$ENDIF}
// ComCtrls, // LCL
//////////////////////////////////////////////////// ComCtrls, Classes, LCLType, LMessages, Controls, Graphics,
WSComCtrls, WSLCLClasses; LCLProc,
// widgetset
WSComCtrls, WSLCLClasses, WSProc,
// interface
GtkDef;
type type
@ -67,8 +71,14 @@ type
TGtkWSCustomListView = class(TWSCustomListView) TGtkWSCustomListView = class(TWSCustomListView)
private private
class procedure InternalChangeItem(const ACListWidget: PGtkCList; const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
protected protected
public public
class procedure ChangeItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); override;
class procedure DeleteItem(const ALV: TCustomListView; const AIndex: Integer); override;
class procedure InsertItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); override;
class procedure SelectItem(const ALV: TCustomListView; const AItem: TListItem); override;
class procedure ShowItem(const ALV: TCustomListView; const AItem: TListItem); override;
end; end;
{ TGtkWSListView } { TGtkWSListView }
@ -119,22 +129,6 @@ type
public public
end; end;
{ TGtkWSToolButton }
TGtkWSToolButton = class(TWSToolButton)
private
protected
public
end;
{ TGtkWSToolBar }
TGtkWSToolBar = class(TWSToolBar)
private
protected
public
end;
{ TGtkWSTrackBar } { TGtkWSTrackBar }
TGtkWSTrackBar = class(TWSTrackBar) TGtkWSTrackBar = class(TWSTrackBar)
@ -162,6 +156,160 @@ type
implementation implementation
uses
SysUtils,
GtkProc, GtkInt, GtkGlobals,
GtkWSControls;
{ TGtkWSCustomListView }
procedure TGtkWSCustomListView.ChangeItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
var
WidgetInfo: PWidgetInfo;
CListWidget: PGtkCList;
begin
if not WSCheckHandleAllocated(ALV, 'ChangeItem')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ALV.Handle));
CListWidget := PGtkCList(WidgetInfo^.CoreWidget);
InternalChangeItem(CListWidget, ALV, AIndex, AItem);
end;
procedure TGtkWSCustomListView.DeleteItem(const ALV: TCustomListView; const AIndex: Integer);
var
WidgetInfo: PWidgetInfo;
CListWidget: PGtkCList;
begin
if not WSCheckHandleAllocated(ALV, 'DeleteItem')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ALV.Handle));
CListWidget := PGtkCList(WidgetInfo^.CoreWidget);
gtk_clist_remove(CListWidget, AIndex);
end;
type
TLVHack = class(TCustomListView)
end;
procedure TGtkWSCustomListView.InternalChangeItem(const ACListWidget: PGtkCList; const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
var
ImageBitmap, MaskBitmap: TBitmap;
ImageRect: TRect;
Pixmap: PGdkPixmap;
Mask: PGdkBitmap;
n, Count: integer;
// pStr: PChar;
begin
// pStr:=PChar(ListItem.Caption);
// if pStr=nil then pStr:=#0;
if (TLVHack(ALV).SmallImages <> nil)
and (AItem.ImageIndex >= 0)
and (AItem.ImageIndex < TLVHack(ALV).SmallImages.Count)
then begin
// set image & caption
TLVHack(ALV).SmallImages.GetInternalImage(AItem.ImageIndex, ImageBitmap, MaskBitmap, ImageRect);
if (ImageRect.Left <> 0)
or (ImageRect.Top <> 0)
then DebugLn('WARNING: TGtkWidgetSet.ListViewChangeItem does not support combined imagelists');
Pixmap := PGDIObject(ImageBitmap.Handle)^.GDIPixmapObject;
Mask := PGdkBitmap(PGDIObject(ImageBitmap.Handle)^.GDIBitmapMaskObject);
gtk_clist_set_pixtext(ACListWidget, AIndex, 0, PChar(AItem.Caption), 3, Pixmap, Mask);
end
else begin
// set caption alone
gtk_clist_set_text(ACListWidget, AIndex, 0, PChar(AItem.Caption));
end;
// set the other column texts
Count := AItem.SubItems.Count + 1;
if Count > ACListWidget^.Columns
then Count := ACListWidget^.Columns;
// set the existing subitems
for n := 1 to Count - 1 do
gtk_clist_set_text(ACListWidget, AIndex, n, PChar(AItem.SubItems[n - 1]));
// fill remaining
for n := Count to ACListWidget^.Columns - 1 do
gtk_clist_set_text(ACListWidget, AIndex, n, #0);
end;
procedure TGtkWSCustomListView.InsertItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
var
WidgetInfo: PWidgetInfo;
CListWidget: PGtkCList;
Titles: PPGChar;
idx, Count: Integer;
begin
if not WSCheckHandleAllocated(ALV, 'InsertItem')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ALV.Handle));
CListWidget := PGtkCList(WidgetInfo^.CoreWidget);
Count := CListWidget^.columns;
if Count = 0
then begin
DebugLn('WARNING: TGtkWSCustomListView.InsertItem CListWidget^.columns = 0');
Exit;
end;
GetMem(Titles, SizeOf(PGChar) * Count);
FillChar(Titles^, SizeOf(PGChar) * Count, 0);
Titles[0] := #0;
idx := AIndex;
if idx = -1
then idx := gtk_clist_append(CListWidget, Titles)
else gtk_clist_insert(CListWidget, idx, Titles);
FreeMem(Titles);
InternalChangeItem(CListWidget, ALV, idx, AItem);
end;
procedure TGtkWSCustomListView.SelectItem(const ALV: TCustomListView; const AItem: TListItem);
var
WidgetInfo: PWidgetInfo;
CListWidget: PGtkCList;
begin
if not WSCheckHandleAllocated(ALV, 'SelectItem')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ALV.Handle));
CListWidget := PGtkCList(WidgetInfo^.CoreWidget);
gtk_clist_unselect_all(CListWidget);
if AItem <> nil
then gtk_clist_select_row(CListWidget, AItem.Index, 0);
end;
procedure TGtkWSCustomListView.ShowItem(const ALV: TCustomListView; const AItem: TListItem);
var
WidgetInfo: PWidgetInfo;
CListWidget: PGtkCList;
idx: Integer;
begin
if not WSCheckHandleAllocated(ALV, 'ShowItem')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(ALV.Handle));
CListWidget := PGtkCList(WidgetInfo^.CoreWidget);
//0=NotVisible
//1=PartiallyVisible
//2=Fully Visible
idx := AItem.Index;
if gtk_clist_row_is_visible(CListWidget, idx) < 2
then gtk_clist_moveto(CListWidget, idx, 0, 1, 0);
end;
initialization initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -173,7 +321,7 @@ initialization
// RegisterWSComponent(TStatusBar, TGtkWSStatusBar); // RegisterWSComponent(TStatusBar, TGtkWSStatusBar);
// RegisterWSComponent(TTabSheet, TGtkWSTabSheet); // RegisterWSComponent(TTabSheet, TGtkWSTabSheet);
// RegisterWSComponent(TPageControl, TGtkWSPageControl); // RegisterWSComponent(TPageControl, TGtkWSPageControl);
// RegisterWSComponent(TCustomListView, TGtkWSCustomListView); RegisterWSComponent(TCustomListView, TGtkWSCustomListView);
// RegisterWSComponent(TListView, TGtkWSListView); // RegisterWSComponent(TListView, TGtkWSListView);
// RegisterWSComponent(TProgressBar, TGtkWSProgressBar); // RegisterWSComponent(TProgressBar, TGtkWSProgressBar);
// RegisterWSComponent(TCustomUpDown, TGtkWSCustomUpDown); // RegisterWSComponent(TCustomUpDown, TGtkWSCustomUpDown);

48
lcl/widgetset/wscomctrls.pp
View File

@ -44,7 +44,7 @@ uses
// To get as little as posible circles, // To get as little as posible circles,
// uncomment only when needed for registration // uncomment only when needed for registration
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// ComCtrls, ComCtrls,
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
WSLCLClasses, WSControls, WSExtCtrls, WSStdCtrls, WSLCLClasses, WSControls, WSExtCtrls, WSStdCtrls,
WSToolwin; WSToolwin;
@ -67,7 +67,13 @@ type
{ TWSCustomListView } { TWSCustomListView }
TWSCustomListViewClass = class of TWSCustomListView;
TWSCustomListView = class(TWSWinControl) TWSCustomListView = class(TWSWinControl)
class procedure ChangeItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); virtual;
class procedure DeleteItem(const ALV: TCustomListView; const AIndex: Integer); virtual;
class procedure InsertItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem); virtual;
class procedure SelectItem(const ALV: TCustomListView; const AItem: TListItem); virtual;
class procedure ShowItem(const ALV: TCustomListView; const AItem: TListItem); virtual;
end; end;
{ TWSListView } { TWSListView }
@ -118,6 +124,44 @@ type
implementation implementation
uses
// TODO: remove when implemented on win32
Controls, LMessages;
{ TWSCustomListView }
procedure TWSCustomListView.ChangeItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
begin
// TODO: remove when implemented on win32
CNSendMessage(LM_LV_CHANGEITEM, ALV, @AIndex);
end;
procedure TWSCustomListView.DeleteItem(const ALV: TCustomListView; const AIndex: Integer);
begin
// TODO: remove when implemented on win32
CNSendMessage(LM_LV_DELETEITEM, ALV ,@AIndex);
end;
procedure TWSCustomListView.InsertItem(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
begin
// TODO: remove when implemented on win32
CNSendMessage(LM_LV_ADDITEM, ALV, @AIndex);
end;
procedure TWSCustomListView.SelectItem(const ALV: TCustomListView; const AItem: TListItem);
begin
// TODO: remove when implemented on win32
CNSendMessage(LM_LV_SELECTITEM, ALV, AItem);
end;
procedure TWSCustomListView.ShowItem(const ALV: TCustomListView; const AItem: TListItem);
begin
// TODO: remove when implemented on win32
CNSendMessage(LM_LV_SHOWITEM, ALV, AItem);
end;
initialization initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -127,7 +171,7 @@ initialization
// RegisterWSComponent(TStatusBar, TWSStatusBar); // RegisterWSComponent(TStatusBar, TWSStatusBar);
// RegisterWSComponent(TTabSheet, TWSTabSheet); // RegisterWSComponent(TTabSheet, TWSTabSheet);
// RegisterWSComponent(TPageControl, TWSPageControl); // RegisterWSComponent(TPageControl, TWSPageControl);
// RegisterWSComponent(TCustomListView, TWSCustomListView); RegisterWSComponent(TCustomListView, TWSCustomListView);
// RegisterWSComponent(TListView, TWSListView); // RegisterWSComponent(TListView, TWSListView);
// RegisterWSComponent(TProgressBar, TWSProgressBar); // RegisterWSComponent(TProgressBar, TWSProgressBar);
// RegisterWSComponent(TCustomUpDown, TWSCustomUpDown); // RegisterWSComponent(TCustomUpDown, TWSCustomUpDown);