paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 17:49:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Keith: Fixes for Win32

Browse Source 
git-svn-id: trunk@652 -
This commit is contained in:
lazarus 2002-02-01 10:13:09 +00:00
parent ffb07a8f59
commit d2c64aa547
8 changed files with 74 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -1540,7 +1540,7 @@ endif
.PHONY: lcl components ide tools all clean .PHONY: lcl components ide tools all clean
.SUFFIXES: .rc .res .SUFFIXES: .rc .res
%.res: %.rc %.res: %.rc
windres -i $< -o $@ windres -i $< -o $@ --preprocessor cpp
ide: ide:
ifeq ($(OS_TARGET), win32) ifeq ($(OS_TARGET), win32)
$(MAKE) lazarus.res $(MAKE) lazarus.res

2
Makefile.fpc
View File

@ -44,7 +44,7 @@ endif
.SUFFIXES: .rc .res .SUFFIXES: .rc .res
%.res: %.rc %.res: %.rc
windres -i $< -o $@ windres -i $< -o $@ --preprocessor cpp
ide: ide:
ifeq ($(OS_TARGET), win32) ifeq ($(OS_TARGET), win32)

8
examples/bitbtnform.pp
View File

@ -90,6 +90,8 @@ begin
left := 125; left := 125;
caption := 'Close'; caption := 'Close';
Checked := True; Checked := True;
Height := 15;
Width := 60;
Show; Show;
end; end;
@ -102,6 +104,8 @@ begin
left := 125; left := 125;
caption := 'Ok'; caption := 'Ok';
Checked := False; Checked := False;
Height := 15;
Width := 50;
Show; Show;
end; end;
@ -114,6 +118,8 @@ begin
left := 125; left := 125;
caption := 'Cancel'; caption := 'Cancel';
Checked := False; Checked := False;
Height := 15;
Width := 65;
Show; Show;
end; end;
@ -126,6 +132,8 @@ begin
left := 125; left := 125;
caption := 'Help'; caption := 'Help';
Checked := False; Checked := False;
Height := 15;
Width := 55;
Show; Show;
end; end;

11
examples/scrollbar.pp
View File

@ -53,6 +53,7 @@ constructor TForm1.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
Caption := 'Scrollbar Demo v0.1'; Caption := 'Scrollbar Demo v0.1';
Height := 350;
ScrollBar1 := TSCrollBar.Create(self); ScrollBar1 := TSCrollBar.Create(self);
with SCrollbar1 do with SCrollbar1 do
@ -76,34 +77,38 @@ begin
Visible := True; Visible := True;
Caption := 'Button1'; Caption := 'Button1';
onclick := @button1clicked; onclick := @button1clicked;
Width := 65;
end; end;
Button2 := TButton.create(self); Button2 := TButton.create(self);
with Button2 do with Button2 do
begin begin
Parent := self; Parent := self;
Left := 25; Left := 65;
Visible := True; Visible := True;
Caption := 'Button2'; Caption := 'Button2';
onclick := @button2clicked; onclick := @button2clicked;
Width := 65;
end; end;
Button3 := TButton.create(self); Button3 := TButton.create(self);
with Button3 do with Button3 do
begin begin
Parent := self; Parent := self;
Left := 55; Left := 130;
Visible := True; Visible := True;
Caption := 'Button3'; Caption := 'Button3';
onclick := @button3clicked; onclick := @button3clicked;
Width := 65;
end; end;
Button4 := TButton.create(self); Button4 := TButton.create(self);
with Button4 do with Button4 do
begin begin
Parent := self; Parent := self;
Left := 100; Left := 195;
Visible := True; Visible := True;
Caption := 'Button4'; Caption := 'Button4';
onclick := @button4clicked; onclick := @button4clicked;
Width := 65;
end; end;
end; end;

5
examples/trackbar.pp
View File

@ -172,7 +172,7 @@ begin
Track1.Parent := Self; Track1.Parent := Self;
Track1.Left := 50; Track1.Left := 50;
Track1.Top := 150; Track1.Top := 150;
Track1.Width := 200; Track1.Width := 140;
Track1.Height := 140; Track1.Height := 140;
Track1.Min := 0; Track1.Min := 0;
Track1.Max := 100; Track1.Max := 100;
@ -301,6 +301,9 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002/02/01 10:13:09 lazarus
Keith: Fixes for Win32
Revision 1.2 2000/07/23 19:04:42 lazarus Revision 1.2 2000/07/23 19:04:42 lazarus
enhanced examples, stoppok enhanced examples, stoppok

5
lcl/interfaces/win32/win32int.pp
View File

@ -88,7 +88,7 @@ Type
Procedure CreateComponent(Sender: TObject); Procedure CreateComponent(Sender: TObject);
Procedure AddChild(Parent, Child: HWND; Left, Top: Integer); Procedure AddChild(Parent, Child: HWND; Left, Top: Integer);
Procedure ResizeChild(Window: HWND; Left, Top, Width, Height: Integer); Procedure ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
Function GetLabel(CompStyle: Integer; Window: HWnd): String; Function GetLabel(CompStyle: Integer; Window: HWnd): String;
Procedure AssignSelf(Window: HWnd; Data: Pointer); Procedure AssignSelf(Window: HWnd; Data: Pointer);
Procedure ReDraw(Child: TObject); Procedure ReDraw(Child: TObject);
@ -332,6 +332,9 @@ End.
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.9 2002/02/01 10:13:09 lazarus
Keith: Fixes for Win32
Revision 1.8 2002/01/31 09:32:07 lazarus Revision 1.8 2002/01/31 09:32:07 lazarus
Keith: Keith:
* Open and save dialogs can now coexist in apps (however, only one of each type of common dialog can be used per app :( ) * Open and save dialogs can now coexist in apps (however, only one of each type of common dialog can be used per app :( )

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

@ -38,8 +38,8 @@ Constructor TWin32ListStringList.Create(List: HWND);
Begin Begin
Inherited Create; Inherited Create;
If List = HWND(Nil) Then If List = HWND(Nil) Then
//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;
End; End;
@ -153,10 +153,11 @@ End;
Procedure TWin32ListStringList.Insert(Index: Integer; Const S: String); Procedure TWin32ListStringList.Insert(Index: Integer; Const S: String);
Var Var
Li: HWND; Li: HWND;
begin Begin
SendMessage(FWin32List, CB_INSERTSTRING, Index, LPARAM(PChar(S))); SendMessage(FWin32List, CB_INSERTSTRING, Index, LPARAM(PChar(S)));
if FSorted then Sort; If FSorted Then
end; Sort;
End;
{*************************************************************} {*************************************************************}
{ TWin32CListStringList methods } { TWin32CListStringList methods }
@ -306,7 +307,7 @@ Var
CSize: Integer; CSize: Integer;
K: Integer; K: Integer;
Begin Begin
SendMessage(FWin32CList, CB_INSERTSTRING, Index, LPARAM(PChar(S))); SendMessage(FWin32CList, CB_INSERTSTRING, Index, LPARAM(PChar(@S)));
End; End;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -329,6 +330,9 @@ End;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.3 2002/02/01 10:13:09 lazarus
Keith: Fixes for Win32
Revision 1.2 2002/01/17 03:17:44 lazarus Revision 1.2 2002/01/17 03:17:44 lazarus
Keith: Fixed TPage creation Keith: Fixed TPage creation

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

@ -148,6 +148,7 @@ End;
Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer); Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer);
Var Var
Handle, Wnd: HWnd; Handle, Wnd: HWnd;
I: Integer;
P: Pointer; P: Pointer;
TbBI: TBBUTTONINFO; TbBI: TBBUTTONINFO;
TCI: TC_ITEM; TCI: TC_ITEM;
@ -185,8 +186,6 @@ Begin
Assert(False, Format('Trace:TWin32Object.SetLabel - Got %S', [CS_To_String(TControl(Sender).FCompStyle)])); Assert(False, Format('Trace:TWin32Object.SetLabel - Got %S', [CS_To_String(TControl(Sender).FCompStyle)]));
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');
SendMessage(Handle, CB_DELETESTRING, (Sender As TComboBox).ItemIndex, 0);
SendMessage(Handle, CB_INSERTSTRING, (Sender As TComboBox).ItemIndex, LPARAM(Data));
End; End;
csPage: csPage:
Begin Begin
@ -535,7 +534,7 @@ activate_time : the time at which the activation event occurred.
If Sender Is TWinControl Then If Sender Is TWinControl Then
With (Sender As TWinControl), PRect(Data)^ Do With (Sender As TWinControl), PRect(Data)^ Do
If HandleAllocated Then If HandleAllocated Then
ResizeChild(Handle, Left, Top, Right, Bottom); ResizeChild(Sender, Left, Top, Right, Bottom);
End; End;
LM_SHOWMODAL: LM_SHOWMODAL:
Begin Begin
@ -703,7 +702,7 @@ activate_time : the time at which the activation event occurred.
Else Else
Raise Exception.Create('Message LM_GETITEMS - Not implemented'); Raise Exception.Create('Message LM_GETITEMS - Not implemented');
End; End;
Data := TWin32ListStringList.Create(Control); Data := TWin32ListStringList.Create(Handle{Control});
Result := Integer(Data); Result := Integer(Data);
End; End;
End; End;
@ -1116,7 +1115,7 @@ Begin
TWinControl(Sender).Parent := Nil; TWinControl(Sender).Parent := Nil;
TWinControl(Sender).Parent := AParent; TWinControl(Sender).Parent := AParent;
ResizeChild(TWinControl(Sender).Handle, TWinControl(Sender).Left, TWinControl(Sender).Top, TWinControl(Sender).Width, TWinControl(Sender).Height); ResizeChild(Sender, TWinControl(Sender).Left, TWinControl(Sender).Top, TWinControl(Sender).Width, TWinControl(Sender).Height);
ShowHide(Sender); ShowHide(Sender);
Result := 0; Result := 0;
@ -1427,14 +1426,18 @@ End;
Resize a window Resize a window
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
Procedure TWin32Object.ResizeChild(Window: HWND; Left, Top, Width, Height: Integer); Procedure TWin32Object.ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
Var Var
Handle: HWND; Handle: HWND;
R: TRect; R: TRect;
Begin Begin
//Handle := (Sender As TWinControl).Handle; Handle := (Sender As TWinControl).Handle;
If (Sender Is TButton) Then
Height := Height - 4;
If TControl(Sender).Parent Is TCustomGroupBox Then
Top := Top + 14;
//If Handle <> HWND(Nil) Then //If Handle <> HWND(Nil) Then
MoveWindow(Window, Left, Top, Width, Height, True) MoveWindow(Handle, Left, Top, Width, Height, True)
{Else {Else
Begin Begin
GetClientRect(Handle, R); GetClientRect(Handle, R);
@ -1534,6 +1537,7 @@ Type
Var Var
AccelIndex: Byte; AccelIndex: Byte;
AItems: TMenuItem; AItems: TMenuItem;
AProcess: TProcess;
Bottom, CompStyle, I, J, K, Left, Right, Top: Integer; Bottom, CompStyle, I, J, K, Left, Right, Top: Integer;
Buddy, Handle, ParentWindow, Window: HWnd; Buddy, Handle, ParentWindow, Window: HWnd;
Caption : String; Caption : String;
@ -1573,6 +1577,7 @@ Begin
Else Else
Parent :=((Sender As TWinControl).Parent As TPage).Parent.Handle; Parent :=((Sender As TWinControl).Parent As TPage).Parent.Handle;
Assert(False, Format('Trace:TWin32Object.CreateComponent - parent handle --> 0x%X', [Parent])); Assert(False, Format('Trace:TWin32Object.CreateComponent - parent handle --> 0x%X', [Parent]));
Assert(False, 'Trace:Setting parent'); Assert(False, 'Trace:Setting parent');
End End
Else Else
@ -1659,7 +1664,7 @@ Begin
Flags := Flags Or BS_PUSHBUTTON Flags := Flags Or BS_PUSHBUTTON
Else Else
Flags := Flags Or BS_DEFPUSHBUTTON; Flags := Flags Or BS_DEFPUSHBUTTON;
Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags, Left, Top, Width, Height - 8, Parent, HMENU(Nil), HInstance, Nil);
Assert(False, 'Trace:CreateComponent - Button Window Handle Value = $' + IntToHex(Window, 8)); Assert(False, 'Trace:CreateComponent - Button Window Handle Value = $' + IntToHex(Window, 8));
Assert(False, 'Trace:CreateComponent - Creating a Button - SetProp'); Assert(False, 'Trace:CreateComponent - Creating a Button - SetProp');
If Window <> HWND(Nil) Then If Window <> HWND(Nil) Then
@ -1670,8 +1675,19 @@ Begin
Begin Begin
Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Code style csCalendar'); Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Code style csCalendar');
Assert(False, 'Trace:TODO: TWin32Object.CreateComponent (style csCalendar) - Opening the date/time control applet. This will have to be good enough for now.'); Assert(False, 'Trace:TODO: TWin32Object.CreateComponent (style csCalendar) - Opening the date/time control applet. This will have to be good enough for now.');
Window := CreateWindow('CalendarWndClass', StrTemp, Flags, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil); {$IFDEF VER1_0_4}
AProcess := TProcess.Create('control timedate.cpl', [poNoConsole]);
{$ELSE}
AProcess := TProcess.Create(TComponent(Sender).Owner);
AProcess.CommandLine := 'control timedate.cpl';
AProcess.Options := [poNoConsole];
{$ENDIF}
AProcess.Execute;
Window := HWND(AProcess);
//Window := CreateWindow('CalendarWndClass', StrTemp, Flags, Left, Top, Width, Height, Parent, HMenu(Nil), HInstance, Nil);
SetName(Window, StrTemp); SetName(Window, StrTemp);
AProcess.Free;
AProcess := Nil;
End; End;
csCanvas: csCanvas:
Begin Begin
@ -1688,8 +1704,7 @@ Begin
End; End;
csComboBox: csComboBox:
Begin Begin
Window := CreateWindow('COMBOBOX', Nil, Flags Or CBS_AUTOHSCROLL Or CBS_DROPDOWN, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('COMBOBOX', Nil, Flags Or CBS_AUTOHSCROLL Or CBS_DROPDOWNLIST Or CBS_HASSTRINGS, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SendMessage(Window, CB_ADDSTRING, 0, LPARAM(LPCTSTR(StrTemp)));
SetProp(Window, 'Lazarus', Sender); SetProp(Window, 'Lazarus', Sender);
SetName(Window, StrTemp); SetName(Window, StrTemp);
End; End;
@ -1791,7 +1806,7 @@ Begin
End; End;
csFrame: csFrame:
Begin Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil); Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX Or BS_TOP, 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;
@ -2301,7 +2316,7 @@ Begin
Assert(False, Format('Trace:WARNING: [TWin32Object.GetValue] %S --> No Decendant of TWinControl', [Sender.ClassName])); Assert(False, Format('Trace:WARNING: [TWin32Object.GetValue] %S --> No Decendant of TWinControl', [Sender.ClassName]));
Handle := TWinControl(Sender).Handle; Handle := TWinControl(Sender).Handle;
Assert (Handle = 0, 'WARNING: TWin32Object.GetValue --> got no window'); Assert (Handle = 0, 'Trace:WARNING: TWin32Object.GetValue --> got no window');
Case TControl(Sender).FCompStyle Of Case TControl(Sender).FCompStyle Of
csTrackbar: csTrackbar:
@ -2418,11 +2433,13 @@ Begin
End; End;
csRadiobutton, csCheckbox: csRadiobutton, csCheckbox:
Begin Begin
If TCheckBoxState(Data) = cbChecked Then If TCheckBoxState(Data^) = cbChecked Then
SendMessage(Handle, BM_SETCHECK, BST_CHECKED, 0) SendMessage(Handle, BM_SETCHECK, WParam(BST_CHECKED), 0)
Else If TCheckboxState(Data^) = cbUnchecked Then
SendMessage(Handle, BM_SETCHECK, WParam(BST_UNCHECKED), 0)
Else Else
SendMessage(Handle, BM_SETCHECK, BST_UNCHECKED, 0); SendMessage(Handle, BM_SETCHECK, WParam(BST_INDETERMINATE), 0);
End; End
Else Else
Assert (True, Format('Trace:WARNING: [TWin32Object.SetValue] failed for %S', [Sender.ClassName])); Assert (True, Format('Trace:WARNING: [TWin32Object.SetValue] failed for %S', [Sender.ClassName]));
End; End;
@ -3020,6 +3037,9 @@ End;
{ {
$Log$ $Log$
Revision 1.13 2002/02/01 10:13:09 lazarus
Keith: Fixes for Win32
Revision 1.12 2002/01/31 09:32:07 lazarus Revision 1.12 2002/01/31 09:32:07 lazarus
Keith: Keith:
* Open and save dialogs can now coexist in apps (however, only one of each type of common dialog can be used per app :( ) * Open and save dialogs can now coexist in apps (however, only one of each type of common dialog can be used per app :( )