* Fixes for Win32
  * Added new listviewtest.pp example

git-svn-id: trunk@659 -
This commit is contained in:
lazarus 2002-02-04 10:54:33 +00:00
parent 38c4c4b2d6
commit b1e06b7653
9 changed files with 221 additions and 57 deletions

1
.gitattributes vendored
View File

@ -90,6 +90,7 @@ examples/groupbox.pp svneol=native#text/pascal
examples/hello.pp svneol=native#text/pascal
examples/helloform.pp svneol=native#text/pascal
examples/listboxtest.pp svneol=native#text/pascal
examples/listviewtest.pp svneol=native#text/pascal
examples/memotest.pp svneol=native#text/pascal
examples/messagedialogs.pp svneol=native#text/pascal
examples/notebk.pp svneol=native#text/pascal

View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/31]
# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/19]
#
default: all
override PATH:=$(subst \,/,$(PATH))
@ -161,7 +161,7 @@ LCL_PLATFORM=gtk
endif
export LCL_PLATFORM
endif
override TARGET_UNITS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox scrollbar memotest groupbox speedtest toolbar messagedialogs notebooktest testall
override TARGET_UNITS+=hello notebk comdialogs progressbar trackbar listboxtest bitbutton combobox checkbox scrollbar edittest memotest groupbox speedtest toolbar messagedialogs notebooktest listviewtest testall
override CLEAN_FILES+=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT))
override COMPILER_OPTIONS+=-gl
override COMPILER_UNITDIR+=../lcl/units ../lcl/units/$(LCL_PLATFORM) .. .
@ -1327,7 +1327,7 @@ fpc_info:
@$(ECHO) Ld........ $(LD)
@$(ECHO) Ar........ $(AR)
@$(ECHO) Rc........ $(RC)
@$(ECHO)
@$(ECHO)
@$(ECHO) Mv........ $(MVPROG)
@$(ECHO) Cp........ $(CPPROG)
@$(ECHO) Rm........ $(RMPROG)

View File

@ -8,8 +8,9 @@ version=0.8a
[target]
units=hello notebk comdialogs progressbar trackbar listboxtest \
bitbutton combobox checkbox scrollbar memotest groupbox \
speedtest toolbar messagedialogs notebooktest testall
bitbutton combobox checkbox scrollbar edittest memotest \
groupbox speedtest toolbar messagedialogs notebooktest \
listviewtest testall
[require]
packages=fcl regexpr

View File

@ -30,13 +30,13 @@ program edittest;
{$mode objfpc}
uses
buttons, classes, forms, controls, sysutils, Graphics, mwcustomedit, mwPasSyn;
buttons, classes, forms, controls, sysutils, Graphics, SynEdit, SynHighlighterPas;
type
TEditTestForm = class(TForm)
public
FEdit: TmwCustomEdit;
FHighlighter: TmwPasSyn;
FEdit: TSynEdit;
FHighlighter: TSynPasSyn;
constructor Create(AOwner: TComponent); override;
end;
@ -57,24 +57,20 @@ begin
if FHighlighter = nil
then begin
FHighlighter := TmwPasSyn.Create(Self);
FHighlighter := TSynPasSyn.Create(Self);
FHighlighter.CommentAttri.Foreground := clNavy;
FHighlighter.NumberAttri.Foreground := clRed;
FHighlighter.KeyAttri.Foreground := clGreen;
end;
FEdit := TmwCustomEdit.Create(Self);
FEdit := TSynEdit.Create(Self);
with FEdit
do begin
Parent := Self;
Width := 300;
Height := 200;
{$IFDEF NEW_EDITOR}
Gutter.Color := clBtnface;
Gutter.ShowLineNumbers := True;
{$ELSE}
GutterColor := clBtnface;
{$ENDIF}
Color := clWindow;
Visible := True;
Font.Name := 'courier';
@ -91,6 +87,11 @@ end.
{
$Log$
Revision 1.2 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
Revision 1.1 2000/12/31 15:48:41 lazarus
MWE:
+ Added Editor test app.

95
examples/listviewtest.pp Normal file
View File

@ -0,0 +1,95 @@
{
/***************************************************************************
ListViewTest.pp
-------------------
Test aplication for list views
Initial Revision : Sun Dec 31 17:30:00:00 CET 2000
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
}
program ListViewTest;
uses
Classes, Buttons, ComCtrls, Forms, SysUtils;
type
TMyForm = class(TForm)
private
FItemIndex: Cardinal;
public
ListView: TListView;
Button1: TButton;
constructor Create(AOwner: TComponent); override;
procedure Button1Click(Sender: TObject);
end;
var
MyForm: TMyForm;
constructor TMyForm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'List View Test';
Width := 200;
Height := 300;
ListView := TListView.Create(Self);
ListView.Parent := Self;
ListView.Height := 120;
ListView.Width := 150;
ListView.Show;
Button1 := TButton.Create(Self);
with Button1 do
begin
Parent := Self;
Caption := 'Add Item';
Top := 130;
Left := 10;
Height := 25;
Width := 65;
OnClick := @Button1Click;
Show;
end;
Show;
end;
procedure TMyForm.Button1Click(Sender: TObject);
var
Item: TListItem;
begin
Inc(FItemIndex);
Item := ListView.Items.Add;
Item.Caption := Format('Item %D', [FItemIndex]);
end;
begin
Application.Initialize;
Application.CreateForm(TMyForm, MyForm);
Application.Run;
end.
{
$Log$
Revision 1.1 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
}

View File

@ -86,7 +86,7 @@ Begin
Assert(False, 'Trace:WindowProc - Checking Proc');
Assert(False, Format('Trace:WindowProc - Window Value: $%S; Msg Value: %S; WParam: $%S; LParam: $%S', [IntToHex(Window, 4), WM_To_String(Msg), IntToHex(WParam, 4), IntToHex(LParam, 4)]));
Case Msg Of
LM_MONTHCHANGED..LM_DAYCHANGED:
Begin
@ -1485,6 +1485,11 @@ end;}
{
$Log$
Revision 1.9 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
Revision 1.8 2002/02/03 06:06:25 lazarus
Keith: Fixed Win32 compilation problems

View File

@ -19,8 +19,8 @@ Function DefaultCompareFunc(A, B: HWND): Integer; CDecl;
Var
AStr, BStr: PChar;
Begin
GetWindowText(A, @AStr, GetWindowTextLength(A) + 1);
GetWindowText(B, @BStr, GetWindowTextLength(B) + 1);
GetWindowText(A, AStr, GetWindowTextLength(A) + 1);
GetWindowText(B, BStr, GetWindowTextLength(B) + 1);
Result := StrComp(AStr, BStr);
end;
@ -41,6 +41,8 @@ Begin
Raise Exception.Create('Unspecified list window');
//Assert(False, 'Trace:Unspecified list window');
FWin32List := List;
FSender := TControl(GetProp(FWin32List, 'Lazarus'));
FOrigHeight := FSender.Height;
End;
{------------------------------------------------------------------------------
@ -106,7 +108,7 @@ Begin
Raise Exception.Create('Out of bounds.')
Else
Begin
SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(@Item));
SendMessage(FWin32List, CB_GETLBTEXT, Index, LPARAM(Item));
End;
Result := StrPas(Item);
End;
@ -130,6 +132,7 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32ListStringList.Clear;
Begin
FSender.Height := FOrigHeight;
SendMessage(FWin32List, CB_RESETCONTENT, 0, 0);
End;
@ -141,6 +144,8 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32ListStringList.Delete(Index: Integer);
Begin
If GetCount <> 0 Then
FSender.Height := (FSender.Height - (FSender.Height Div GetCount));
SendMessage(FWin32List, CB_DELETESTRING, Index, 0);
End;
@ -154,6 +159,8 @@ Procedure TWin32ListStringList.Insert(Index: Integer; Const S: String);
Var
Li: HWND;
Begin
If GetCount <> 0 Then
FSender.Height := (FSender.Height + (FSender.Height Div GetCount));
SendMessage(FWin32List, CB_INSERTSTRING, Index, LPARAM(PChar(S)));
If FSorted Then
Sort;
@ -175,7 +182,7 @@ Begin
If List = HWND(Nil) Then
Raise Exception.Create('Unspecified list widget');
FWin32CList := List;
end;
End;
{------------------------------------------------------------------------------
Method: TWin32CListStringList.SetSorted
@ -191,7 +198,7 @@ Begin
If Val Then
Sort
Else
SetWindowLong(FWin32CList, GWL_STYLE, GetWindowLong(FWin32CList, GWL_STYLE) And Not CBS_SORT);
SetWindowLong(FWin32CList, GWL_STYLE, GetWindowLong(FWin32CList, GWL_STYLE) And Not LBS_SORT);
End;
End;
@ -203,7 +210,7 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32CListStringList.Sort;
Begin
SetWindowLong(FWin32CList, GWL_STYLE, GetWindowLong(FWin32CList, GWL_STYLE) Or CBS_SORT);
SetWindowLong(FWin32CList, GWL_STYLE, GetWindowLong(FWin32CList, GWL_STYLE) Or LBS_SORT);
End;
{------------------------------------------------------------------------------
@ -235,7 +242,7 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32CListStringList.Clear;
Begin
SendMessage(FWin32CList, CB_RESETCONTENT, 0, 0);
SendMessage(FWin32CList, LB_RESETCONTENT, 0, 0);
End;
{------------------------------------------------------------------------------
@ -246,7 +253,7 @@ End;
------------------------------------------------------------------------------}
procedure TWin32CListStringList.Delete(Index: Integer);
begin
SendMessage(FWin32CList, CB_DELETESTRING, Index, 0);
SendMessage(FWin32CList, LB_DELETESTRING, Index, 0);
end;
{------------------------------------------------------------------------------
@ -263,7 +270,7 @@ Begin
Raise Exception.Create('Out of bounds.')
Else
Begin
SendMessage(FWin32CList, CB_GETLBTEXT, Index, LPARAM(@Item));
SendMessage(FWin32CList, LB_GETTEXT, Index, LPARAM(Item));
Result := StrPas(Item);
End;
End;
@ -276,7 +283,7 @@ End;
------------------------------------------------------------------------------}
Function TWin32CListStringList.GetCount: Integer;
Begin
Result := SendMessage(FWin32CList, CB_GETCOUNT, 0, 0);
Result := SendMessage(FWin32CList, LB_GETCOUNT, 0, 0);
End;
{------------------------------------------------------------------------------
@ -287,7 +294,7 @@ End;
------------------------------------------------------------------------------}
Function TWin32CListStringList.GetObject(Index: Integer): TObject;
Begin
HWND(Result) := SendMessage(FWin32CList, CB_GETITEMDATA, Index, 0);
HWND(Result) := SendMessage(FWin32CList, LB_GETITEMDATA, Index, 0);
End;
{------------------------------------------------------------------------------
@ -307,7 +314,7 @@ Var
CSize: Integer;
K: Integer;
Begin
SendMessage(FWin32CList, CB_INSERTSTRING, Index, LPARAM(PChar(@S)));
SendMessage(FWin32CList, LB_INSERTSTRING, Index, LPARAM(PChar(S)));
End;
{------------------------------------------------------------------------------
@ -318,7 +325,7 @@ End;
------------------------------------------------------------------------------}
Procedure TWin32CListStringList.PutObject(Index: Integer; AObject: TObject);
Begin
SendMessage(FWin32CList, CB_SETITEMDATA, Index, LPARAM(AObject));
SendMessage(FWin32CList, LB_SETITEMDATA, Index, LPARAM(AObject));
End;
{$IFDEF H_PLUS}
@ -330,6 +337,11 @@ End;
{ =============================================================================
$Log$
Revision 1.4 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
Revision 1.3 2002/02/01 10:13:09 lazarus
Keith: Fixes for Win32

View File

@ -1,7 +1,7 @@
(******************************************************************************
win32listslh.inc
TWin32ListStringList and TWin32CListStringList
******************************************************************************)
{$IFOPT H+}
@ -15,18 +15,20 @@ Type
Private
FWin32List: HWND;
FSorted: Boolean;
FSender: TControl;
FOrigHeight: Integer;
Protected
Function Get(Index: Integer): String; Override;
Function GetCount: Integer; Override;
Procedure SetSorted(Val: Boolean); Virtual;
Procedure SetSorted(Val: Boolean); Virtual;
Public
Constructor Create(List: HWND);
Procedure Assign(Source: TPersistent); Override;
Procedure Clear; Override;
Procedure Delete(Index: Integer); Override;
Procedure Insert(Index: Integer; Const S: String); Override;
Procedure Sort; Virtual;
Property Sorted: Boolean Read FSorted Write SetSorted;
Procedure Sort; Virtual;
Property Sorted: Boolean Read FSorted Write SetSorted;
End;
TWin32CListStringList = Class(TStrings)
@ -45,8 +47,8 @@ Type
Procedure Clear; Override;
Procedure Delete(Index: Integer); Override;
Procedure Insert(Index: Integer; Const S: String); Override;
Procedure Sort; Virtual;
Property Sorted: Boolean Read FSorted Write SetSorted;
Procedure Sort; Virtual;
Property Sorted: Boolean Read FSorted Write SetSorted;
End;
{$IFDEF H_PLUS}
@ -58,6 +60,11 @@ Type
{ =============================================================================
$Log$
Revision 1.2 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
Revision 1.1 2002/01/06 23:09:53 lazarus
MG: added missing files

View File

@ -107,11 +107,21 @@ Begin
Data := '';
Result := True;
Case Sender.FCompStyle Of
csComboBox:
Begin
CapLen := SendMessage((Sender As TWinControl).Handle, CB_GETLBTEXTLEN, CNSendMessage(LM_GETITEMINDEX, Self, Nil), 0);
Caption := StrAlloc(CapLen + 1);
SendMessage((Sender As TWinControl).Handle, CB_GETLBTEXT, CNSendMessage(LM_GETITEMINDEX, Self, Nil), LPARAM(Caption));
Data := StrPas(Caption);
StrDispose(Caption);
End;
csEdit, csMemo:
Begin
CapLen := GetWindowTextLength((Sender As TWinControl).Handle);
Caption := StrAlloc(CapLen + 1);
GetWindowText((Sender As TWinControl).Handle, Caption, CapLen + 1);
Data := StrPas(Caption);
StrDispose(Caption);
End;
csPage:
Begin
@ -187,6 +197,10 @@ Begin
Assert(False, Format('Trace:TWin32Object.SetLabel - label --> %S', [String(PChar(Data))]));
Assert(False, 'Trace:TWin32Object.SetLabel - I''m not sure if this''ll work');
End;
csMemo:
Begin
SendMessage(Handle, WM_SETTEXT, 0, LPARAM(Data));
End;
csPage:
Begin
Assert(False, 'Trace: TWin32Object.SetLabel - Got csPage');
@ -405,7 +419,16 @@ Begin
If Sender Is TListView Then
Begin
Num := Integer(Data^);
ListView_SetItemCount(Handle, Num);
ListItemIndex := (Sender As TListView).Items[Num];
With LVI Do
Begin
Mask := LVIF_TEXT;
IItem := Num;
PSzText := PChar(ListItemIndex.Caption);
WriteLn('item: ', Num, ', caption: ', String(PSzText));
ListView_SetItem(Handle, LVI);
End;
For I := 0 To ListItemIndex.SubItems.Count - 1 Do
Begin
With LVI Do
@ -414,8 +437,8 @@ Begin
IItem := Num;
ISubItem := I + 1;
PSzText := PChar(ListItemIndex.SubItems.Strings[I]);
ListView_SetItem(Handle, LVI);
End;
ListView_SetItem(Handle, LVI);
End;
End;
End;
@ -423,14 +446,18 @@ Begin
Begin
If Sender Is TListView Then
Begin
ListItemIndex := TListView(Sender).Items[TListView(Sender).Items.Count];
ListItemIndex := TListView(Sender).Items[TListView(Sender).Items.Count - 1];
With LVI Do
Begin
Mask := LVIF_TEXT;
IItem := TListView(Sender).Items.Count + 1;
PSzText := PChar(ListItemIndex.Caption);
IItem := TListView(Sender).Items.Count - 1;
CCHTextMax := MAX_PATH;
PSzText := StrAlloc(Length(ListItemIndex.Caption) + 1);
StrPCopy(PSzText, ListItemIndex.Caption);
ListView_InsertItem(Handle, LVI);
ListView_Update(Handle, IItem);
StrDispose(PSzText);
End;
ListView_InsertItem(Handle, LVI);
End;
End;
LM_BRINGTOFRONT:
@ -1331,17 +1358,16 @@ Begin
If Sender Is TOpenDialog Then
Begin
OpenFile := LPOpenFileName(@Sender)^;
//FN := (Sender As TFileDialog).FileName;
ZeroMemory(@OpenFile, SizeOf(OpenFileName));
With OpenFile Do
Begin
LStructSize := SizeOf(OpenFileName);
HWndOwner := ((Sender As TComponent).Owner As TWinControl).Handle;
//LPStrFilter := PChar((Sender As TFileDialog).Filter);
//If FN <> '' Then
//LPStrFile := PChar(FN);
//LPStrFileTitle := PChar((Sender As TCommonDialog).Title);
LPStrInitialDir := PChar((Sender As TFileDialog).InitialDir);
LPStrFilter := PChar((Sender As TOpenDialog).Filter);
{If (Sender As TOpenDialog).FileName <> '' Then
LPStrFile := PChar((Sender As TOpenDialog).FileName);}
LPStrFileTitle := PChar((Sender As TOpenDialog).Title);
LPStrInitialDir := PChar((Sender As TOpenDialog).InitialDir);
Flags := GetFlagsFromOptions((Sender As TOpenDialog).Options);
End;
Ret := GetOpenFileName(@OpenFile)
@ -1349,19 +1375,18 @@ Begin
Else If Sender Is TSaveDialog Then
Begin
OpenFile := LPOpenFileName(@Sender)^;
FN := (Sender As TFileDialog).FileName;
ZeroMemory(@OpenFile, SizeOf(OpenFileName));
With OpenFile Do
Begin
LStructSize := SizeOf(OpenFileName);
HWndOwner := ((Sender As TComponent).Owner As TWinControl).Handle;
//LPStrFilter := PChar((Sender As TFileDialog).Filter);
//If FN <> '' Then
//LPStrFile := PChar(FN);
//LPStrFileTitle := PChar((Sender As TCommonDialog).Title);
LPStrInitialDir := PChar((Sender As TFileDialog).InitialDir);
//If Sender Is TOpenDialog Then
// Flags := GetFlagsFromOptions((Sender As TOpenDialog).Options);
LPStrFilter := PChar((Sender As TSaveDialog).Filter);
{If (Sender As TSaveDialog).FileName <> '' Then
LPStrFile := PChar((Sender As TSaveDialog).FileName);}
LPStrFileTitle := PChar((Sender As TSaveDialog).Title);
LPStrInitialDir := PChar((Sender As TSaveDialog).InitialDir);
If Sender Is TOpenDialog Then
Flags := GetFlagsFromOptions((Sender As TOpenDialog).Options);
End;
Ret := GetSaveFileName(@OpenFile);
End;
@ -1708,7 +1733,7 @@ Begin
End;
csComboBox:
Begin
Window := CreateWindow('COMBOBOX', Nil, Flags Or CBS_AUTOHSCROLL Or CBS_DROPDOWNLIST Or CBS_HASSTRINGS, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
Window := CreateWindow('COMBOBOX', Nil, Flags Or CBS_DROPDOWN, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
SetName(Window, StrTemp);
End;
@ -1740,7 +1765,7 @@ Begin
Begin
Window := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', StrTemp, Flags Or ES_AUTOHSCROLL, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
SetName(Window, strTemp);
SetName(Window, StrTemp);
End;
csColorDialog, csFileDialog, csFontDialog:
Begin
@ -2526,14 +2551,14 @@ begin
If Smooth Then
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or PBS_SMOOTH)
Else
SetWindowLong(HWND(Handle), GWL_STYLE, GetWindowLong(HWND(Handle), GWL_STYLE) Or Not PBS_SMOOTH);
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) And Not PBS_SMOOTH);
Case Orientation Of
pbVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or PBS_VERTICAL);
pbRightToLeft:
Begin
Assert(False, 'TRACE:TRYING to create a right-to-left progress bar');
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(HWND(Handle), GWL_EXSTYLE) And Not WS_EX_LTRREADING);
SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) And Not WS_EX_LTRREADING);
End;
pbTopDown:
Begin
@ -2559,6 +2584,12 @@ begin
Begin
SendMessage(Handle, SBM_SETRANGE, Min, Max);
SendMessage(Handle, SBM_SETPOS, Position, LPARAM(True));
Case Kind Of
sbHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_HORZ);
sbVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or SBS_VERT);
End;
Assert(False, 'Trace:TODO: [TWin32Object.SetProperties] Set up step and page increments for csScrollBar');
End;
csTrackbar:
@ -2569,6 +2600,12 @@ begin
SendMessage(Handle, TBM_SETPOS, WPARAM(True), Position);
SendMessage(Handle, TBM_SETLINESIZE, 0, LineSize);
SendMessage(Handle, TBM_SETPAGESIZE, 0, PageSize);
Case Orientation Of
trVertical:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_VERT);
trHorizontal:
SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) Or TBS_HORZ);
End;
If ShowScale Then
Begin
Case ScalePos of
@ -3050,6 +3087,11 @@ End;
{
$Log$
Revision 1.15 2002/02/04 10:54:33 lazarus
Keith:
* Fixes for Win32
* Added new listviewtest.pp example
Revision 1.14 2002/02/03 06:06:25 lazarus
Keith: Fixed Win32 compilation problems