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

Keith:

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -90,6 +90,7 @@ examples/groupbox.pp svneol=native#text/pascal
examples/hello.pp svneol=native#text/pascal examples/hello.pp svneol=native#text/pascal
examples/helloform.pp svneol=native#text/pascal examples/helloform.pp svneol=native#text/pascal
examples/listboxtest.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/memotest.pp svneol=native#text/pascal
examples/messagedialogs.pp svneol=native#text/pascal examples/messagedialogs.pp svneol=native#text/pascal
examples/notebk.pp svneol=native#text/pascal examples/notebk.pp svneol=native#text/pascal

6
examples/Makefile
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 default: all
override PATH:=$(subst \,/,$(PATH)) override PATH:=$(subst \,/,$(PATH))
@ -161,7 +161,7 @@ LCL_PLATFORM=gtk
endif endif
export LCL_PLATFORM export LCL_PLATFORM
endif 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 CLEAN_FILES+=$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT))
override COMPILER_OPTIONS+=-gl override COMPILER_OPTIONS+=-gl
override COMPILER_UNITDIR+=../lcl/units ../lcl/units/$(LCL_PLATFORM) .. . override COMPILER_UNITDIR+=../lcl/units ../lcl/units/$(LCL_PLATFORM) .. .
@ -1327,7 +1327,7 @@ fpc_info:
@$(ECHO) Ld........ $(LD) @$(ECHO) Ld........ $(LD)
@$(ECHO) Ar........ $(AR) @$(ECHO) Ar........ $(AR)
@$(ECHO) Rc........ $(RC) @$(ECHO) Rc........ $(RC)
@$(ECHO) @$(ECHO)
@$(ECHO) Mv........ $(MVPROG) @$(ECHO) Mv........ $(MVPROG)
@$(ECHO) Cp........ $(CPPROG) @$(ECHO) Cp........ $(CPPROG)
@$(ECHO) Rm........ $(RMPROG) @$(ECHO) Rm........ $(RMPROG)

5
examples/Makefile.fpc
View File

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

19
examples/edittest.pp
View File

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

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

@ -86,7 +86,7 @@ Begin
Assert(False, 'Trace:WindowProc - Checking Proc'); 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)])); 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 Case Msg Of
LM_MONTHCHANGED..LM_DAYCHANGED: LM_MONTHCHANGED..LM_DAYCHANGED:
Begin Begin
@ -1485,6 +1485,11 @@ end;}
{ {
$Log$ $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 Revision 1.8 2002/02/03 06:06:25 lazarus
Keith: Fixed Win32 compilation problems Keith: Fixed Win32 compilation problems

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

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

19
lcl/interfaces/win32/win32listslh.inc
View File

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

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

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