paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 18:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

AJ: Started Form Scrolling

Browse Source 
Started StaticText FocusControl
    Fixed Misc Dialog Problems
    Added TApplication.Title

git-svn-id: trunk@3544 -
This commit is contained in:
lazarus 2002-10-23 20:47:27 +00:00
parent 2155274f8c
commit 2f6d95cb38
6 changed files with 82 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
lcl/forms.pp
View File

@ -200,12 +200,12 @@ type
TFormState = set of (fsCreating, fsVisible, fsShowing, fsModal, fsCreatedMDIChild);
TModalResult = low(Integer)..high(Integer);
TCustomForm = class(TWinControl)
TCustomForm = class(TScrollingWinControl)
private
FActive : Boolean;
FActiveControl : TWinControl;
FBorderStyle : TFormBorderStyle;
FCanvas : TControlCanvas;
// FCanvas : TControlCanvas;
FDesigner : TIDesigner;
FFormStyle : TFormStyle;
FFormState: TFormState;
@ -219,7 +219,7 @@ type
FOnDestroy: TNotifyEvent;
FOnHide: TNotifyEvent;
FOnShow: TNotifyEvent;
FOnPaint: TNotifyEvent;
// FOnPaint: TNotifyEvent;
FOnClose: TCloseEvent;
FOnCloseQuery : TCloseQueryEvent;
FPosition : TPosition;
@ -238,7 +238,7 @@ type
procedure SetPosition(Value : TPosition);
procedure SetVisible(Value: boolean);
procedure SetWindowState(Value : TWIndowState);
function GetCanvas: TControlCanvas;
// function GetCanvas: TControlCanvas;
function IsForm : Boolean;
procedure IconChanged(Sender: TObject);
function IsIconStored: Boolean;
@ -264,7 +264,6 @@ type
// Delphi needed GetClientRect for window specific things, LCL not
// Function GetClientRect : TRect ; Override;
procedure Notification(AComponent: TComponent; Operation : TOperation);override;
procedure Paint; dynamic;
procedure PaintWindow(dc : Hdc); override;
procedure RequestAlign; override;
procedure UpdateShowing; override;
@ -285,7 +284,7 @@ type
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
property OnHide: TNotifyEvent read FOnHide write FOnHide;
property OnShow: TNotifyEvent read FOnShow write FOnShow;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
// property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property OnResize stored IsForm;
property Position : TPosition read FPosition write SetPosition default poDesigned;
public
@ -304,7 +303,7 @@ type
property Active : Boolean read FActive;
property BorderStyle : TFormBorderStyle
read FBorderStyle write SetBorderStyle default bsSizeable;
property Canvas: TControlCanvas read GetCanvas;
//property Canvas: TControlCanvas read GetCanvas;
property Caption stored IsForm;
property Designer : TIDesigner read FDesigner write SetDesigner;
property FormStyle : TFormStyle read FFormStyle write SetFormStyle default fsNormal;
@ -433,6 +432,7 @@ type
FOnException: TExceptionEvent;
FOnIdle: TIdleEvent;
FTerminate : Boolean;
FTitle : String;
// MWE:Do we need this ??
// function ProcessMessage(Var Msg : TMsg) : Boolean;
procedure wndproc(var Message : TLMessage);
@ -469,6 +469,7 @@ type
property MainForm: TForm read FMainForm;
property OnException: TExceptionEvent read FOnException write FOnException;
property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
property Title: String read GetTitle write FTitle;
end;
TIDesigner = class(TObject)

28
lcl/include/customform.inc
View File

@ -326,7 +326,7 @@ begin
Exclude(FControlState, csCustomPaint);
end;
//writeln('[TCustomForm.WMPaint] END ',Name,':',ClassName);
end;
end;
{------------------------------------------------------------------------------
@ -437,18 +437,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCustomForm.Paint
Params: none
Returns: nothing
Calls user handler
------------------------------------------------------------------------------}
Procedure TCustomForm.Paint;
begin
if Assigned (FOnPaint) and not(Isresizing) then FOnPaint(Self);
end;
{------------------------------------------------------------------------------
Method: TCustomForm.PaintWindow
Params: none
@ -900,14 +888,6 @@ begin
Visible := False;
end;
{------------------------------------------------------------------------------}
{ TCustomForm Method GetCanvas "Returns the drawing surface" }
{------------------------------------------------------------------------------}
function TCustomForm.GetCanvas: TControlCanvas;
begin
result := FCanvas;
end;
{------------------------------------------------------------------------------}
{ TCustomForm Method IsForm }
{------------------------------------------------------------------------------}
@ -1163,6 +1143,12 @@ end;
{ =============================================================================
$Log$
Revision 1.64 2002/10/23 20:47:26 lazarus
AJ: Started Form Scrolling
Started StaticText FocusControl
Fixed Misc Dialog Problems
Added TApplication.Title
Revision 1.63 2002/10/22 18:54:56 lazarus
MG: fixed menu streaming

29
lcl/include/customstatictext.inc
View File

@ -19,7 +19,7 @@
TODO:
- FocusControl
- Enable Tabbing/Focusing to focus FocusControl
- Enable Escaped '&' Shortcut to focus FocusControl
- Compare/Match AutoSize to Delphi/Kylix's
- ?? Check For Full Delphi/Kylix Compatibility
@ -61,6 +61,27 @@ begin
end;
end;
procedure TCustomStaticText.Notification(AComponent : TComponent; Operation : TOperation);
begin
inherited Notification(AComponent, Operation);
if (AComponent = FFocusControl) and (Operation = opRemove) then
FFocusControl:= nil;
end;
procedure TCustomStaticText.SetFocusControl(Value : TWinControl);
begin
if Value <> FFocusControl then begin
FFocusControl:= Value;
if Value <> nil then Value.FreeNotification(Self);
end;
end;
procedure TCustomStaticText.WMActivate(var Message: TLMActivate);
begin
if (FFocusControl <> nil) and (FFocusControl.CanFocus) then
FFocusControl.SetFocus;
end;
Function TCustomStaticText.GetAlignment : TAlignment;
begin
Result := FAlignment;
@ -158,6 +179,12 @@ end;
{
$Log$
Revision 1.2 2002/10/23 20:47:26 lazarus
AJ: Started Form Scrolling
Started StaticText FocusControl
Fixed Misc Dialog Problems
Added TApplication.Title
Revision 1.1 2002/10/21 15:51:27 lazarus
AJ: moved TCustomStaticText code to include/customstatictext.inc

12
lcl/include/messagedialogs.inc
View File

@ -492,17 +492,17 @@ end;
procedure ShowMessage(const aMsg: string);
begin
NotifyUser(aMsg, idDialogInfo);
NotifyUser(aMsg, idDialogBase);
end;
procedure ShowMessageFmt(const aMsg: string; Params: array of const);
begin
NotifyUser(Format(aMsg, Params), idDialogInfo);
NotifyUser(Format(aMsg, Params), idDialogBase);
end;
procedure ShowMessagePos(const aMsg: string; X, Y: Integer);
begin
NotifyUserAtXY(aMsg, idDialogInfo, X, Y);
NotifyUserAtXY(aMsg, idDialogBase, X, Y);
end;
//----------------------------------------------------------------------------//
@ -532,6 +532,12 @@ end;
{
$Log$
Revision 1.18 2002/10/23 20:47:26 lazarus
AJ: Started Form Scrolling
Started StaticText FocusControl
Fixed Misc Dialog Problems
Added TApplication.Title
Revision 1.17 2002/10/23 14:36:52 lazarus
AJ:Fixes to PromptUser;Switched ShowMessage* to use NotifyUser*;
fixed TGraphicPropertyEditor for when Property is nil.

39
lcl/interfaces/gnome/gnomewinapi.inc
View File

@ -70,7 +70,7 @@ end;
such as OK/Cancel Yes/No etc.. It can be used to display errors, warnings,
or other information, or to ask questions.
------------------------------------------------------------------------------}
Function PromptUserWidget(const DialogCaption, DialogMessage : String;
Function TGnomeObject.PromptUserWidget(const DialogCaption, DialogMessage : String;
DialogType : longint; Buttons : PLongint; ButtonCount, DefaultIndex : Longint) : Pointer;
var
BoxType : PChar;
@ -79,9 +79,8 @@ var
BTNArray : PPgChar;
StockName : PgChar;
I : Longint;
TXTList : PGList;
TXTLayout : PGnomeIconTextInfo;
NewMessage : AnsiString;
NewMessage : PgChar;
ScreenDC : hDC;
begin
If (Application.MainForm <> nil) and
(Application.MainForm.HandleAllocated)
@ -128,26 +127,12 @@ begin
BTNArray[I] := StockName;
end;
BTNArray[ButtonCount] := nil;
TXTLayout := gnome_icon_layout_text(PGDIObject(GetStockObject(SYSTEM_FONT))^.GDIFontObject,
PgChar(DialogMessage), ' ', Screen.Width div 3, False);
TXTList := TXTLayout^.Rows;
While TXTList <> nil do begin
If TXTList^.Data <> nil then
NewMessage := NewMessage + AnsiString(PGnomeIconTextInfoRow(TXTList^.Data)^.thetext);
TXTList := TXTList^.Next;
If TXTList <> nil then
If NewMessage[Length(NewMessage)] <> #10 then
NewMessage := NewMessage + #10;
end;
NewMessage := Copy(NewMessage, 1, Length(NewMessage));
gnome_icon_text_info_free(TXTLayout);
Result := gnome_message_box_newv(PgChar(NewMessage), BoxType, BTNArray);
ScreenDC := GetDC(0);
SelectObject(ScreenDC, GetStockObject(SYSTEM_FONT));
NewMessage := ForceLineBreaks(ScreenDC, PgChar(DialogMessage), Screen.Width div 3, False);
ReleaseDC(0,ScreenDC);
Result := gnome_message_box_newv(NewMessage, BoxType, BTNArray);
FreeMem(NewMessage);
If (DefaultIndex >= ButtonCount) or (DefaultIndex < 0)
then
DefaultIndex := 0;
@ -293,6 +278,12 @@ end;
{
$Log$
Revision 1.11 2002/10/23 20:47:27 lazarus
AJ: Started Form Scrolling
Started StaticText FocusControl
Fixed Misc Dialog Problems
Added TApplication.Title
Revision 1.10 2002/10/23 14:36:53 lazarus
AJ:Fixes to PromptUser;Switched ShowMessage* to use NotifyUser*;
fixed TGraphicPropertyEditor for when Property is nil.

15
lcl/stdctrls.pp
View File

@ -820,21 +820,27 @@ type
Private
FAlignment: TAlignment;
FBorderStyle: TStaticBorderStyle;
FFocusControl : TWinControl;
FShowAccelChar: Boolean;
Procedure FontChange(Sender : TObject);
protected
Procedure DoAutoSize; Override;
Procedure CMTextChanged(var Message: TLMSetText); message CM_TEXTCHANGED;
procedure WMActivate(var Message: TLMActivate); message LM_ACTIVATE;
procedure Notification(AComponent : TComponent; Operation : TOperation); override;
Procedure SetAlignment(Value : TAlignment);
Function GetAlignment : TAlignment;
Procedure SetBorderStyle(Value : TStaticBorderStyle);
Function GetBorderStyle : TStaticBorderStyle;
Procedure SetFocusControl(Value : TWinControl);
Procedure SetShowAccelChar(Value : Boolean);
Function GetShowAccelChar : Boolean;
property Alignment: TAlignment read GetAlignment write SetAlignment;
property BorderStyle: TStaticBorderStyle read GetBorderStyle write SetBorderStyle;
property FocusControl : TWinControl read FFocusControl write SetFocusControl;
property ShowAccelChar: Boolean read GetShowAccelChar write SetShowAccelChar;
public
constructor Create(AOwner: TComponent); override;
@ -852,6 +858,7 @@ type
property Color;
property Constraints;
property Enabled;
property FocusControl;
property Font;
property ParentColor;
property ParentFont;
@ -859,6 +866,8 @@ type
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
@ -1396,6 +1405,12 @@ end.
{ =============================================================================
$Log$
Revision 1.59 2002/10/23 20:47:26 lazarus
AJ: Started Form Scrolling
Started StaticText FocusControl
Fixed Misc Dialog Problems
Added TApplication.Title
Revision 1.58 2002/10/21 15:51:27 lazarus
AJ: moved TCustomStaticText code to include/customstatictext.inc