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

Intermediate UI patch to show a bug.

Browse Source 
git-svn-id: trunk@3279 -
This commit is contained in:
lazarus 2002-09-03 20:02:01 +00:00
parent da2e467433
commit 939e1f6074
5 changed files with 38 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
examples/messagedialogs.pp
View File

@ -70,9 +70,10 @@ end;
procedure TMainForm.Button1Click(Sender : TObject);
begin
ShowMessage ('First simple test!');
writeln('Go to second dialog');
MessageDlg ('Caption', 'Two buttons now...', mtError, [mbOK,mbCancel], 0);
MessageDlg ('Warning, not fully implemented', mtWarning, [mbYes, mbNo, mbOK,mbCancel], 0);
ShowMessageFmt ('The show will end now'+#13+'%s'+#13+'Good bye!!!', [MainForm.Caption]);
ShowMessageFmt ('The show will end now'+LineEnding+'%s'+LineEnding+'Good bye!!!', [MainForm.Caption]);
close;
end;
@ -84,6 +85,9 @@ begin
end.
{
$Log$
Revision 1.5 2002/09/03 20:02:01 lazarus
Intermediate UI patch to show a bug.
Revision 1.4 2002/08/30 10:06:07 lazarus
Fixed alignment of multiline TLabel.
Simplified and prettified MessageBoxen.

2
ide/lazarusidestrconsts.pas
View File

@ -194,7 +194,7 @@ ResourceString
lisSelectDFMFiles = 'Select Delphi form files (*.dfm)';
// dialogs
lisSaveChangesToProject = 'Save changes to project?';
lisSaveChangesToProject = 'Save changes to project %s?';
lisProjectChanged = 'Project changed';
lisFPCSourceDirectoryError = 'FPC Source Directory error';

10
lcl/include/customform.inc
View File

@ -964,7 +964,7 @@ Function TCustomForm.ShowModal : Integer;
SaveCount: Integer;
ActiveWindow: HWnd;}
begin
//writeln('[TCustomForm.ShowModal] START ',Classname);
//writeln('[TCustomForm.ShowModal] START ',Classname);
if Visible or not Enabled or (fsModal in FFormState) or
(FormStyle = fsMDIChild) then
raise EInvalidOperation.Create('TCustomForm.ShowModal impossible');
@ -983,11 +983,12 @@ begin
SaveCount := Screen.FCursorCount;
WindowList := DisableTaskWindows(0);}
ModalResult := 0;
try
Show;
try
CNSendMessage(LM_SHOWMODAL, Self, nil);
Repeat
repeat
{ Delphi calls Application.HandleMessage
But HandleMessage processes all pending events and then calls idle,
which will wait for new messages. Under Win32 there always a next
@ -1001,6 +1002,7 @@ begin
if ModalResult<>0 then break;
Application.Idle;
until ModalResult <> 0;
Result := ModalResult;
//if GetActiveWindow <> Handle then ActiveWindow := 0;
finally
@ -1025,7 +1027,11 @@ end;
{ =============================================================================
$Log$
Revision 1.56 2002/09/03 20:02:01 lazarus
Intermediate UI patch to show a bug.
Revision 1.55 2002/09/03 11:32:49 lazarus
Added shortcut keys to labels
Support for alphabetically sorting the properties
Standardize message and add shortcuts ala Kylix

6
lcl/include/customlabel.inc
View File

@ -106,7 +106,7 @@ procedure TCustomLabel.SetShowAccelChar(Val : boolean);
begin
if Val <> FShowAccelChar then begin
FShowAccelChar:= Val;
CNSendMessage(LM_SETLABEL, Self, PChar(Caption));
if HandleAllocated then CNSendMessage(LM_SETLABEL, Self, PChar(Caption));
end;
end;
@ -144,7 +144,11 @@ end;
{ =============================================================================
$Log$
Revision 1.6 2002/09/03 20:02:01 lazarus
Intermediate UI patch to show a bug.
Revision 1.5 2002/09/03 11:32:49 lazarus
Added shortcut keys to labels
Support for alphabetically sorting the properties
Standardize message and add shortcuts ala Kylix

35
lcl/include/messagedialogs.inc
View File

@ -94,6 +94,7 @@ begin
FMsgLines := TStringList.Create;
FLabel := TLabel.Create(Self);
FLabel.Alignment:= taLeftJustify;
FLabel.ShowAccelChar:= false;
FLabel.Parent:= Self;
FLabel.Visible:= true;
@ -168,9 +169,9 @@ end;
function TMessageBox.LineWidth(Index: integer): integer;
begin
if (Index>=0) and (Index<FMsgLines.Count) then
Result:=Canvas.TextWidth(FMsgLines[Index])
Result:= Canvas.TextWidth(FMsgLines[Index])
else
Result:=0;
Result:= 0;
end;
{------------------------------------------------------------------------------
@ -244,8 +245,7 @@ begin
FDlgType := value;
FBitmap.Free;
FBitmap := TBitmap.Create;
FBitmap.Handle := CreatePixmapIndirect(@mtImages[FDlgType],
ColorToRGB(clBtnFace));
FBitmap.Handle := CreatePixmapIndirect(@mtImages[FDlgType], ColorToRGB(clBtnFace));
if DefaultCaption then
Caption := cMtCaption[FDlgType];
end;
@ -279,7 +279,6 @@ const
cBtnDist = cBtnWidth + 4;
cMinLeft = cBitmapX + cBitmapWidth + cLabelSpacing;
var
aButton : TBitBtn; // temp. variable to create buttons
aBitmap : TBitmap; // temp. variable to create bitmaps for buttons
curBtn : TMsgDlgBtn; // variable to loop through TMsgDlgButtons
ButtonLeft : integer; // left position of button(s)
@ -291,11 +290,11 @@ var
i, j : integer;
ButtonIndex : integer;
begin
if FUpdateCounter>0 then exit;
if FUpdateCounter > 0 then exit;
// calculate label width
LabelWidth:= 0;
for i:=0 to FMsgLines.Count-1 do begin
for i:=0 to FMsgLines.Count - 1 do begin
j:=LineWidth(i);
if j > LabelWidth then LabelWidth:= j;
end;
@ -335,9 +334,9 @@ begin
for curBtn := low(TMsgDlgBtn) to high(TMsgDlgBtn) do begin
if curBtn in FButtons then begin
inc(ButtonIndex);
aButton := TBitBtn.Create(self);
With aButton do begin
Parent := Self;
with TBitBtn.Create(Self) do begin
Parent:= Self;
SetBounds (ButtonLeft, 2 * cLabelSpacing + reqHeight, cBtnWidth, cBtnHeight);
inc(ButtonLeft, cBtnDist);
Layout := blGlyphLeft;
@ -373,9 +372,8 @@ end;
procedure TMessageBox.EndUpdate;
begin
dec(FUpdateCounter);
if FUpdateCounter<0 then FUpdateCounter:=0;
if (FUpdateCounter=0) and (FRelayoutNeeded) then
ReLayout;
if FUpdateCounter<0 then FUpdateCounter:= 0;
if (FUpdateCounter = 0) and FRelayoutNeeded then ReLayout;
end;
// ---------------------------------------------------------------------------
@ -385,13 +383,13 @@ function CreateMessageDialog(const aMsg: string; DlgType: TMsgDlgType;
var
msgbox : TMessageBox;
begin
msgbox := TMessageBox.Create (application);
msgbox:= TMessageBox.Create(Application);
msgbox.BeginUpdate;
msgbox.theMessage := aMsg;
msgBox.DialogType := DlgType;
msgBox.Buttons := buttons;
msgbox.EndUpdate;
Result := msgbox;
Result:= msgbox;
end;
function CreateMessageDialogWithCap(const aCaption, aMsg: string;
@ -399,14 +397,14 @@ function CreateMessageDialogWithCap(const aCaption, aMsg: string;
var
msgbox : TMessageBox;
begin
msgbox := TMessageBox.Create (Application);
msgbox:= TMessageBox.Create(Application);
msgbox.BeginUpdate;
msgbox.theMessage := aMsg;
msgBox.DialogType := DlgType;
msgBox.Buttons := buttons;
msgBox.Caption := aCaption;
msgbox.EndUpdate;
Result := msgbox;
Result:= msgbox;
end;
function MessageDlg(const aMsg: string; DlgType: TMsgDlgType;
@ -474,6 +472,9 @@ end;
{
$Log$
Revision 1.13 2002/09/03 20:02:01 lazarus
Intermediate UI patch to show a bug.
Revision 1.12 2002/08/30 10:06:07 lazarus
Fixed alignment of multiline TLabel.
Simplified and prettified MessageBoxen.