Exception raised when setting Text property of TEdit in custom component (Lazarus) - custom-component

Using: Lazarus 1.2.0; Windows 32-bit application
I have created a custom component derived from TCustomPanel and contains some TEdit controls.
At runtime, when I try to set the Text property of an edit control in my component, I get a runtime error.
This is the error:
Project project1 raised exception class 'External: SIGSEGV'.
In file '.\include\control.inc' at line 3246:
GetTextMethod := TMethod(#Self.GetTextBuf);
I Googled and could not find anybody else reporting this error specifically when setting the Text property of TEdit.
This leads me to believe that I did something wrong when writing the component. Please check my code and point out what is wrong and how to fix it. TIA!
Code follows:
unit uEditPanel;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
type
{ TEditPanel }
TEditPanel = class(TCustomPanel)
Edit0: TCustomEdit;
Edit1: TCustomEdit;
Edit2: TCustomEdit;
Edit3: TCustomEdit;
Edit4: TCustomEdit;
private
{ Private declarations }
function GetEdit0Text: string;
procedure SetEdit0Text(AText: string);
function GetEdit1Text: string;
procedure SetEdit1Text(AText: string);
function GetEdit2Text: string;
procedure SetEdit2Text(AText: string);
function GetEdit3Text: string;
procedure SetEdit3Text(AText: string);
function GetEdit4Text: string;
procedure SetEdit4Text(AText: string);
protected
{ Protected declarations }
public
{ Public declarations }
procedure CreateWnd; override;
published
{ Published declarations }
property Edit0Text: string read GetEdit0Text write SetEdit0Text;
property Edit1Text: string read GetEdit1Text write SetEdit1Text;
property Edit2Text: string read GetEdit2Text write SetEdit2Text;
property Edit3Text: string read GetEdit3Text write SetEdit3Text;
property Edit4Text: string read GetEdit4Text write SetEdit4Text;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TEditPanel]);
end;
{ TEditPanel }
function TEditPanel.GetEdit0Text: string;
begin
Result := Edit0.Text;
end;
procedure TEditPanel.SetEdit0Text(AText: string);
begin
Edit0.Text := AText;
end;
function TEditPanel.GetEdit1Text: string;
begin
Result := Edit1.Text;
end;
procedure TEditPanel.SetEdit1Text(AText: string);
begin
Edit1.Text := AText;
end;
function TEditPanel.GetEdit2Text: string;
begin
Result := Edit2.Text;
end;
procedure TEditPanel.SetEdit2Text(AText: string);
begin
Edit2.Text := AText;
end;
function TEditPanel.GetEdit3Text: string;
begin
Result := Edit3.Text;
end;
procedure TEditPanel.SetEdit3Text(AText: string);
begin
Edit3.Text := AText;
end;
function TEditPanel.GetEdit4Text: string;
begin
Result := Edit4.Text;
end;
procedure TEditPanel.SetEdit4Text(AText: string);
begin
Edit4.Text := AText;
end;
procedure TEditPanel.CreateWnd;
begin
inherited CreateWnd;
Caption := EmptyStr;
Height := 117;
Width := 289;
BevelOuter := bvNone;
ClientHeight := 117;
ClientWidth := 289;
Edit0 := TCustomEdit.Create(Self);
Edit1 := TCustomEdit.Create(Self);
Edit2 := TCustomEdit.Create(Self);
Edit3 := TCustomEdit.Create(Self);
Edit4 := TCustomEdit.Create(Self);
Edit0.Left := 0;
Edit0.Height := 21;
Edit0.Top := 0;
Edit0.Width := 288;
//Edit0.BorderStyle := bsNone;
Edit0.TabOrder := 0;
Edit1.Left := 0;
Edit1.Height := 21;
Edit1.Top := 24;
Edit1.Width := 288;
// Edit1.BorderStyle := bsNone;
Edit1.TabOrder := 1;
Edit1.Font.Color := clGray;
Edit2.Left := 0;
Edit2.Height := 21;
Edit2.Top := 48;
Edit2.Width := 288;
// Edit2.BorderStyle := bsNone;
Edit2.TabOrder := 2;
Edit2.Font.Color := clGray;
Edit3.Left := 0;
Edit3.Height := 21;
Edit3.Top := 72;
Edit3.Width := 288;
//Edit3.BorderStyle := bsNone;
Edit3.TabOrder := 3;
Edit3.Font.Color := clGray;
Edit4.Left := 0;
Edit4.Height := 21;
Edit4.Top := 96;
Edit4.Width := 288;
//Edit4.BorderStyle := bsNone;
Edit4.TabOrder := 4;
Edit4.Font.Color := clGray;
Edit0.Parent := Self;
Edit1.Parent := Self;
Edit2.Parent := Self;
Edit3.Parent := Self;
Edit4.Parent := Self;
Edit0.SetSubComponent(True);
Edit1.SetSubComponent(True);
Edit2.SetSubComponent(True);
Edit3.SetSubComponent(True);
Edit4.SetSubComponent(True);
end;
end.

Solved. Answer posted by user JuhaManninen on the Lazarus support forum:
"You have no constructor in your class. Replace CreateWnd with a
constructor."

Related

Delphi 10.4. Fast Report 6. REST application. Print Failure

I have created a REST server in Delphi using WebBroker. My intention is to use it as a label printer. A client prepares and sends a JSON request detailing the printer name, Fast Report & variables. The server reads the JSON, creates a tFrxReport object loads the requisite report and populates the variables.
This all works admirably, except it will not print to a physical printer. If I select OneNote as my destination, the label is saved to the desktop. If I select a network attached printer, no label emerges.
I have tried PrintOptions.ShowDialog:=True The print dialog shows, indicating the correct printer, but it does not print.
If anyone has any experience, could you point me in the right direction please?
function processJson(itm : sat; jtr : tJsonTextReader): sat;
var
idx : integer;
//itm : sat; // simple array type [idx, 'val1', 'val2']
begin
setlength(itm,0);
idx:=0;
while jtr.Read do
begin
if jtr.TokenType = tJsonToken.PropertyName then
begin
setlength(itm, length(itm)+1);
itm[idx].st_idx := idx;
itm[idx].st_code := jtr.Value.ToString; // property name
jtr.Read;
itm[idx].st_desc := jtr.Value.AsString; // property value
inc(idx);
end;
end;
processJson := itm;
end;
function getPrinterInfo(pnam: string):printinfo_type;
var
ptr : printinfo_type;
idx : integer;
begin
ptr.idx := -1; //default printer
ptr.name := trim(pnam);
for idx := 0 to Printer.Printers.Count - 1 do
if AnsiContainsText(Printer.Printers[idx], ptr.name) then
ptr.idx := idx;
result := ptr;
end;
procedure Ttfdq.tfdqactLabelAction(Sender: TObject; Request: TWebRequest;
Response: TWebResponse; var Handled: Boolean);
var
post : simpleArray_type;
pdx, idx, iitm : integer;
jtr : tJsonTextReader;
sr : tStringReader;
pish : string;
fr : tFrxReport;
thePtr : printinfo_type;
itm : sat;
tstprt : boolean;
begin
d.myHost := 'http://' + Request.host + ':' + intToStr(Request.ServerPort);
d.hostIP := Request.host;
d.Request := Request;
d.Response := Response;
d.remAddr := Request.RemoteAddr;
post := explode(Request.Content);
tstprt := false;
pdx := isset(post, 'json');
pish:='';
if (pdx >=0) then
begin
sr := tStringReader.Create(post[pdx].st_desc);
jtr := tJsonTextReader.Create(sr);
while jtr.read do
begin
if jtr.TokenType = tJsonToken.StartObject then
itm := processJson(itm, jtr);
end;
if fileexists(itm[2].st_desc) then
begin
thePtr := getPrinterInfo(itm[1].st_desc);
fr := tFrxReport.Create(nil);
fr.LoadFromFile(itm[2].st_desc);
// pre load any vars so report does not fail
for idx := 0 to fr.Variables.Count-1 do
fr.Variables.Items[iitm].Value := frText('');
for idx := 4 to High(itm) do
begin
pish := pish + 'index of '+itm[idx].st_code+' = '+ intToStr (fr.Variables.IndexOf(itm[idx].st_code))+'<br>';
iitm := fr.Variables.IndexOf(itm[idx].st_code);
if iitm > -1 then
fr.Variables.Items[iitm].Value := frText(itm[idx].st_desc);
end;
if fr.PrepareReport then
begin
//fr.ShowPreparedReport;
fr.PrintOptions.Printer := thePtr.name;
fr.PrintOptions.PrnOutFileName := 'Trace Label';
fr.PrintOptions.ShowDialog := tstprt;
fr.ShowProgress := tstprt;
fr.Print;
end;
fr.Free;
end;
Response.Content := pish ;
end
else
begin
Response.Content := '<html>' +
'<head><title>Label List</title></head>' +
'<body>This is only used by print serve clients</p>'+
'</body>' +
'</html>';
end;
end;
The problem lies here:
fr.PrintOptions.PrnOutFileName := 'Trace Label';
I erroneously thought that would add a description in the print queue. What it actually did is send the report into limbo :)

Delphi - Rich edit doesn't show on dynamically created form

I've dynamically created a Form in my program, and it works and shows perfectly, but the RichEdit I've also dynamically created doesn't want to show on the Form at all. How can I show the RichEdit on the Form?
Code I'm using:
procedure TfrmPuntehou.lblAbbClick(Sender: TObject);
var
frmAbb: TForm;
redAbbreviations: TRichEdit;
begin
//opens abbreviations
frmAbb := TForm.Create(nil);
redAbbreviations := TRichEdit.Create(nil);
try
with frmAbb do
begin
Width := 400;
Height := 400;
Caption := 'Abbreviations';
Position := poOwnerFormCenter;
ShowModal;
end;
with redAbbreviations do
begin
Parent := frmAbb;
Width := 300;
Height := 353;
redAbbreviations.Paragraph.TabCount := 2;
redAbbreviations.Paragraph.Tab[0] := 30;
redAbbreviations.Paragraph.Tab[1] := 60;
Lines.Add('DEV'+#9+'='+#9+'SWD Development');
Lines.Add('1660'+#9+'='+#9+'1660s');
Lines.Add('2.1'+#9+'='+#9+'2.1s');
Lines.Add('MIN'+#9+'='+#9+'Minis');
Lines.Add('SR'+#9+'='+#9+'Stockrods');
Lines.Add('PR'+#9+'='+#9+'Pinkrods');
Lines.Add('HR'+#9+'='+#9+'Hotrods');
Lines.Add('HM'+#9+'='+#9+'Heavy Metals');
Lines.Add('V8'+#9+'='+#9+'V8s');
Lines.Add('MA'+#9+'='+#9+'Midgets A');
Lines.Add('MB'+#9+'='+#9+'Midgets B');
Lines.Add('SP'+#9+'='+#9+'Sprints');
Lines.Add('CRO'+#9+'='+#9+'Crosskarts');
Lines.Add('LM'+#9+'='+#9+'Late Models');
Font.Size := 13;
end;
finally
frmAbb.Free;
end;
end;
Move the ShowModal from the initialization part of the frmAbb to the end of the code, just before the finally statement.
procedure TForm1.Button1Click(Sender: TObject);
var
frmAbb: TForm;
redAbbreviations: TRichEdit;
begin
//opens abbreviations
frmAbb := TForm.Create(nil);
try
redAbbreviations := TRichEdit.Create(frmAbb);
with frmAbb do
begin
Width := 400;
Height := 400;
Caption := 'Abbreviations';
Position := poOwnerFormCenter;
end;
with redAbbreviations do
begin
Parent := frmAbb;
Width := 300;
Height := 353;
redAbbreviations.Paragraph.TabCount := 2;
redAbbreviations.Paragraph.Tab[0] := 30;
redAbbreviations.Paragraph.Tab[1] := 60;
Lines.Add('DEV'+#9+'='+#9+'SWD Development');
Lines.Add('1660'+#9+'='+#9+'1660s');
Lines.Add('2.1'+#9+'='+#9+'2.1s');
Lines.Add('MIN'+#9+'='+#9+'Minis');
Lines.Add('SR'+#9+'='+#9+'Stockrods');
Lines.Add('PR'+#9+'='+#9+'Pinkrods');
Lines.Add('HR'+#9+'='+#9+'Hotrods');
Lines.Add('HM'+#9+'='+#9+'Heavy Metals');
Lines.Add('V8'+#9+'='+#9+'V8s');
Lines.Add('MA'+#9+'='+#9+'Midgets A');
Lines.Add('MB'+#9+'='+#9+'Midgets B');
Lines.Add('SP'+#9+'='+#9+'Sprints');
Lines.Add('CRO'+#9+'='+#9+'Crosskarts');
Lines.Add('LM'+#9+'='+#9+'Late Models');
Font.Size := 13;
end;
frmAbb.ShowModal;
finally
frmAbb.Free;
end;
end;
You forgot to make it visible:
redAbbreviations.Visible := TRUE;
And you show the form modal before setting properties to the RichEdit.
Here is the correct reformatted code:
procedure TForm1.Button1Click(Sender: TObject);
var
frmAbb : TForm;
redAbbreviations : TRichEdit;
begin
// opens abbreviations
frmAbb := TForm.Create(nil);
try
redAbbreviations := TRichEdit.Create(frmAbb);
frmAbb.Width := 400;
frmAbb.Height := 400;
frmAbb.Caption := 'Abbreviations';
frmAbb.Position := OwnerFormCenter;
redAbbreviations.Parent := frmAbb;
redAbbreviations.Width := 300;
redAbbreviations.Height := 353;
redAbbreviations.Paragraph.TabCount := 2;
redAbbreviations.Paragraph.Tab[0] := 30;
redAbbreviations.Paragraph.Tab[1] := 60;
redAbbreviations.Lines.Add('DEV'+#9+'='+#9+'SWD Development');
redAbbreviations.Lines.Add('1660'+#9+'='+#9+'1660s');
redAbbreviations.Lines.Add('2.1'+#9+'='+#9+'2.1s');
redAbbreviations.Lines.Add('MIN'+#9+'='+#9+'Minis');
redAbbreviations.Lines.Add('SR'+#9+'='+#9+'Stockrods');
redAbbreviations.Lines.Add('PR'+#9+'='+#9+'Pinkrods');
redAbbreviations.Lines.Add('HR'+#9+'='+#9+'Hotrods');
redAbbreviations.Lines.Add('HM'+#9+'='+#9+'Heavy Metals');
redAbbreviations.Lines.Add('V8'+#9+'='+#9+'V8s');
redAbbreviations.Lines.Add('MA'+#9+'='+#9+'Midgets A');
redAbbreviations.Lines.Add('MB'+#9+'='+#9+'Midgets B');
redAbbreviations.Lines.Add('SP'+#9+'='+#9+'Sprints');
redAbbreviations.Lines.Add('CRO'+#9+'='+#9+'Crosskarts');
redAbbreviations.Lines.Add('LM'+#9+'='+#9+'Late Models');
redAbbreviations.font.Size :=13;
redAbbreviations.Visible := TRUE;
frmAbb.ShowModal;
finally
frmAbb.Free;
end;
end;

Form resource not found after on-the-fly String-Resource translation

I have a problem which occurs only in a very small customer range and I would like to ask if you might give me a hint where the problem might be. The program works for 98% of the customers. Alas, it is not possible that I work with the customers to debug the issue, because their knowledge of Windows and computers is very basic. It is also not possible that I send multiple versions of the product to them, since they don't even know how to install software (the admins do all the stuff).
First of all, I translate all RT_STRING resources on-the-fly, so that the language-switching in the program also affects hardcoded stuff like "Yes", "No", "Cancel" etc., which would only be possible by compiling 2 EXE files.
The code (I have tried to left away as much unnecessary stuff as possible, but since I don't know where the problem is, I provided as much details for the bug as possible):
The ony-the-fly resource translation
procedure TranslateResources;
var
i: integer;
s: string;
{$IF NOT Declared(FILE_ATTRIBUTE_NOT_CONTENT_INDEXED)}
const
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = $2000;
{$IFEND}
begin
// I copy all resources in a dummy DLL (without code), because
// 1) The resources are the only thing we need when changing the resource module
// 2) If the EXE code/debug sections are too long, BeginUpdateResource() will ruin the performance heavily
FTempFile := IncludeTrailingPathDelimiter(GetTempDirectory) + GetRandomString(8)+'.dll';
// Transfers all resources from ParamStr(0) into the dummy DLL at FTempFile
ReGenerateResourceFile(FTempFile);
// if necessary, remove readonly flag
SetFileAttributes(PChar(FTempFile), FILE_ATTRIBUTE_OFFLINE or
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED or
FILE_ATTRIBUTE_TEMPORARY );
for i := 0 to Length(RTLResStringTranslationArray)-1 do
begin
s := Translate(RTLResStringTranslationArray[i].TranslationID);
if s <> '' then
begin
// Translate the string
UpdateResString(RTLResStringTranslationArray[i].ResStrDescriptor.Identifier, s);
end;
end;
LoadNewResourceModule(FTempFile):
end;
procedure ReGenerateResourceFile(OutputFile: string);
var
hUpd: Cardinal;
rs: TResourceStream;
fs: TFileStream;
begin
// As template we use a dummy DLL which contains no code.
// We will implement all resources from ParamStr(0) into it, before we translate the strings.
rs := TResourceStream.Create(HInstance, 'DUMMYDLL', 'DLL');
fs := TFileStream.Create(OutputFile, fmCreate or fmOpenWrite);
try
fs.CopyFrom(rs, rs.Size)
finally
rs.Free;
fs.Free;
end;
// Transfer resources from our EXE into the dummy DLL file
hUpd := BeginUpdateResource(PChar(OutputFile), true);
try
EnumResourceTypes(hInstance, #_enumResTypesProc, hUpd);
finally
EndUpdateResource(hUpd, false)
end;
end;
// This is based on reinit.pas from Borland's RichEdit example; slightly modified
function LoadNewResourceModule(PatchedFile: string): LongInt;
var
NewInst: Longint;
CurModule: PLibModule;
begin
Result := 0;
// Win95: "Initialization routine failed"
// NewInst := LoadLibrary(PChar(PatchedFile));
NewInst := LoadLibraryEx(PChar(PatchedFile), 0, LOAD_LIBRARY_AS_DATAFILE);
CurModule := LibModuleList;
Result := 0;
while CurModule <> nil do
begin
if CurModule.Instance = HInstance then
begin
if CurModule.ResInstance <> CurModule.Instance then
FreeLibrary(CurModule.ResInstance);
// Win95: ERangeError
CurModule^.ResInstance := NewInst;
Result := NewInst;
Exit;
end;
CurModule := CurModule.Next;
end;
end;
// Based on http://stackoverflow.com/questions/1498658/modifying-a-string-in-resource-of-an-exe
// Modified
procedure UpdateResString(const AStringIdent: Integer; const ANewString: WideString);
var
ResData, TempData: TWordArray;
iSection, iIndexInSection: Integer;
i, iLen, iSkip, iPos: Integer;
begin
// Calculate the resource string area and the string index in that area
iSection := AStringIdent div 16 + 1;
iIndexInSection := AStringIdent mod 16;
ResData := ReadSectionCached(iSection);
// Calculate the position of the string
iLen := Length(ANewString);
iPos := 0;
for i := 0 to iIndexInSection do
begin
if iPos > High(ResData) then
begin
SetLength(ResData, iPos + 1);
ResData[iPos] := 0;
end;
if i <> iIndexInSection then
begin
iSkip := ResData[iPos] + 1;
Inc(iPos, iSkip);
end;
end;
// Put data behind strings into TempData
iSkip := 1{size} + ResData[iPos];
SetLength(TempData, Length(ResData) - (iPos + iSkip));
if Length(TempData) > 0 then
begin
CopyMemory(#TempData[0], #ResData[iPos + iSkip], Length(TempData)*SizeOf(TempData[0]));
end;
SetLength(ResData, iPos + (iLen + 1{size}) + Length(TempData));
// Overwrite string
ResData[iPos] := iLen;
Inc(iPos);
if iLen > 0 then
begin
CopyMemory(#ResData[iPos], #ANewString[1], iLen*SizeOf(ANewString[1]));
Inc(iPos, iLen);
end;
// Append TempData after our new string
if Length(TempData) > 0 then
begin
CopyMemory(#ResData[iPos], #TempData[0], Length(TempData)*SizeOf(TempData[0]));
end;
CacheSet(iSection, ResData);
end;
type
TGlobalData = record
GlobalPtr: Pointer;
Length: integer;
end;
function LoadResourcePtr(hModule: HMODULE; restype, resname: PChar; wIDLanguage: WORD): TGlobalData;
var
hFind, hRes: THandle;
begin
result.GlobalPtr := nil;
result.Length := -1;
hFind := Windows.FindResourceEx(hModule, restype, resname, wIDLanguage);
if hFind = 0 then RaiseLastOSError;
hres := Windows.LoadResource(hModule, hFind);
if hres = 0 then RaiseLastOSError;
result.GlobalPtr := Windows.LockResource(hres);
result.Length := Windows.SizeofResource(hModule, hFind);
end;
function _enumResLangsProc(hmodule: HMODULE; restype, resname: PChar; wIDLanguage: WORD;
lParam: LongInt): BOOL; stdcall;
var
rs: TGlobalData;
begin
rs := LoadResourcePtr(hmodule, restype, resname, wIDLanguage);
UpdateResource(lParam, restype, resname, wIDLanguage, rs.GlobalPtr, rs.Length);
result := true;
end;
function _enumResNamesProc(hmodule: HMODULE; restype, resname: PChar;
lParam: LongInt): BOOL; stdcall;
begin
EnumResourceLanguages(hmodule, restype, resname, #_enumResLangsProc, lParam);
result := true;
end;
function _enumResTypesProc(hmodule: HMODULE; restype: PChar;
lParam: LongInt): BOOL; stdcall;
begin
EnumResourceNames(hmodule, restype, #_enumResNamesProc, lParam);
result := true;
end;
{$R '..\dummydll\dummydll.RES'}
Then I use a wait form:
unit Wait;
interface
uses
...
type
TWaitForm = class(TForm)
...
end;
var
WaitForm: TWaitForm;
implementation
{$R *.dfm}
...
end;
The wait form will be called by dynamically showing the form:
procedure ShowWaitForm;
begin
...
{ I use my own _CreateForm function because it solves many workarounds for
juicy stuff like half-modal windows (which can be hidden without user action),
miscellaneous deadlocks etc. and to allow the form to be shown in a shared PAS file
without the requirement to add it to every DPR file where the WaitForm API is used. }
WaitForm := _CreateForm(TWaitForm, {Application.MainForm}AParent) as TWaitForm;
WaitForm.Show;
...
end;
function _CreateForm(InstanceClass: TCustomFormClass; AParent: TCustomForm): TCustomForm;
var
LOwner: TComponent;
begin
if Assigned(AParent) then
begin
LOwner := AParent;
end
else if Assigned(Application) then
begin
LOwner := Application;
end
else
begin
LOwner := nil;
end;
result := InstanceClass.Create(LOwner);
end;
The error message at 2% of the customers:
Resource TWaitForm was not found
However, other forms are working.
There are 2 theories I can think of:
1) Did the resource translation corrupt the DLL file / part of the RCData section? (Maybe a bug in the WinAPI's UpdateResource ?)
2) Is there a problem with the dynamic showing of the wait form (since other "static" forms are shown?)

Delphi: Creating a TComboBox in a dynamically created form at runtime

Okay, I am working in a project that was originally done in D7. And I am doing double duty here as I am working on fixing bugs in the original code and attempting to port it over to XE3/4. Kinda hard when the original author used some none-open source kits for the project.
But anyways, the app is a scripting/macroing program. As part of the custome scripting/macroing language. There is a ability to create very simple basic forms for user input. The forms are created dynamically at runtime based on the script/macro the script/macro author has created. I have already fixed some bugs in the code for the creation of the forms. But, there is one that I just can not figure out.
When creating a TComboBox for the parent form and setting the Text property AT component creation. The text in the Text property is not displayed.
Here is the code to create the form:
procedure CreateForm(var wFrm: TForm; sName: String);
var
iLoop, iPos, iLen: Integer;
iFormHeight, iFormWidth: Integer;
lh, hresult1, hresult2: Integer;
sWork, sWork2, sLine, CmdName: String;
lstForm, lst: TStringList;
pnl: TPanel;
begin
iFormHeight := 80;
iFormWidth := 400;
hresult1 := 0;
lst := TStringList.Create;
iLoop := lstForms.IndexOf(Trim(UpperCase(sName)));
if iLoop < 0 then
begin
AbortError('Form "' + sName + '" could not be found!');
Exit;
end;
lstForm := TStringList(lstForms.Objects[iLoop]);
for iLoop := 0 to lstForm.Count - 1 do
begin
sLine := lstForm[iLoop];
iPos := Pos('=', sLine);
iLen := Length(sLine);
if iPos = 0 then
continue;
CmdName := Uppercase(Trim(Copy(sLine, 1, iPos - 1)));
sWork2 := Trim(Copy(sLine, iPos + 1, iLen));
if CmdName = 'FORMCAPTION' then
begin
with wfrm do
begin
Caption := Trim(Copy(sLine, iPos + 1, iLen));
Name := Trim(sName);
Height := iFormHeight;
Width := iFormWidth;
Tag := 10;
BorderStyle := bsSizeable;
BorderIcons := [biSystemMenu];
Position := poDesktopCenter;
pnl := TPanel.Create(wfrm);
with pnl do
begin
Parent := wfrm;
Caption := '';
Align := alBottom;
BevelInner := bvNone;
BevelOuter := bvNone;
Height := 30;
end;
with TButton.Create(wfrm) do
begin
Parent := pnl;
Caption := '&OK';
Default := True;
ModalResult := mrOK;
Left := 235;
Top := 0;
end;
with TButton.Create(wfrm) do
begin
Parent := pnl;
Caption := '&Cancel';
Cancel := True;
ModalResult := mrCancel;
Left := 310;
Top := 0;
end;
pnl := TPanel.Create(wfrm);
with pnl do
begin
Parent := wfrm;
Caption := '';
Align := alClient;
BevelInner := bvRaised;
BevelOuter := bvNone;
BorderWidth := 5;
end;
end;
end
else
begin
lst.Clear;
StringToList(sWork2, lst, ':');
if UpperCase(lst[0]) = 'EDITBOX' then
CreateEditBox
else if UpperCase(lst[0]) = 'CHECKBOX' then
CreateCheckBox
else if UpperCase(lst[0]) = 'COMBOBOX' then
CreateComboBox
else if UpperCase(lst[0]) = 'LABEL' then
CreateLabel;
end;
end;
with wfrm do
begin
if hresult1 > 1 then
hresult2 := 5
else
hresult2 := 9;
Tag := Tag + hresult2;
Height := Height + hresult2;
end;
lst.Free;
end;
And here is the specific code to create the TComboBox, w/ TLabel, for the form:
procedure CreateComboBox;
var
iPos: Integer;
begin
with TLabel.Create(wfrm) do
begin
Parent := pnl;
Caption := lst[1];
Left := 15;
if hresult1 > 1 then
hresult2 := 5 * hresult1
else
hresult2 := 3 * hresult1;
Top := wfrm.Tag + hresult2;
Name := 'lbl' + CmdName;
Width := 150;
WordWrap := True;
AutoSize := True;
lh := Height;
end;
hresult1 := Trunc(lh/13);
with TComboBox.Create(wfrm) do
begin
Parent := pnl;
Left := 170;
Width := 200;
if hresult1 > 1 then
hresult2 := 5 * hresult1
else
hresult2 := 3 * hresult1;
Top := wfrm.Tag + hresult2;
Style := csDropDownList;
Name := UpperCase(CmdName);
Text := 'Test Text';
sWork := lst[3];
lst.Clear;
StringToList(sWork, lst, ',');
for iPos := 0 to lst.Count - 1 do
lst[iPos] := lst[iPos];
Items.Assign(lst);
// ItemIndex := 0;
end;
wfrm.Tag := wfrm.Tag + ((hresult1 * 13)+ 13);
wfrm.Height := wfrm.Height + ((hresult1 * 13)+ 13);
TComboBox(wfrm
end;
NOTE: the above procedure is a child procedure of the CreateForm procedure.
The app uses TStringList lists to store the form definition at script/macro runtime. Then the above code retrieves that information to create to form when the author wants the form to be shown. And then creates the form and places the form object into another temporary TStringList list prior to being shown. This is done so that when the user runs the script/macro and enters the information/settings as requested in the form. The author may retrieve the requested information/settings from the form before the form is destroyed.
The form is deleted (if previously created) from tmp TStringList list, created, stored in tmp TStringList list, and shown modally with the following code:
iPos := lstForms.IndexOf(UpperCase(sWVar2));
if iPos < 0 then
begin
AbortError('Could not find form "' + Trim(sWVar2) + '" defined!');
Exit;
end;
iPos := lstFormsTMP.IndexOf(UpperCase(sWVar2));
if iPos > -1then
begin
TForm(lstFormsTMP.Objects[iPos]).Free;
lstFormsTMP.Delete(iPos);
frm.Free;
iPos := lstFormsTMP.IndexOf(UpperCase(sWVar2));
if iPos > -1 then
begin
AbortError('Form "' + Trim(sWVar2) + '" was not removed from the lstFormsTMP TStringList.');
Exit;
end;
end;
frm := TForm.Create(frmMain);
CreateForm(frm, sWVar2);
lstFormsTMP.AddObject(Uppercase(sWVar2), frm);
end;
iPos := lstFormsTMP.IndexOf(UpperCase(sWVar2));
if iPos < 0 then
begin
AbortError('Could not find form "' + Trim(sWVar2) + '" defined!');
Exit;
end;
hndHold := SwitchToHandle(frmMain.Handle);
try
Result := TForm(lstFormsTMP.Objects[iPos]).ShowModal = mrOK;
finally
SwitchToHandle(hndHold);
end;
With the above sets of code the form defined in the running script is created and shown, without to many bugs/errors. But, even though I have hardcoded the text for the TComboBox.Text property. It is not shown. Can anyone shed some lite on why this is the case for me? All other form components, TCheckBox, TEditBox, TLabel, are displayed without any issues, so far. It is just the TComboBox that is causing me to scratch my head in confusion.
NOTE: Eventually the TComboBox.Text property will be dynamically set based on the authors setting for that property in the form component's definition.
Thanks in advance.
EDITED 8/18/2013, to include the following:
The original code also includes the ability to save/load the form component's settings by way of the TIniFile object. The following code is used to save the setting for the TComboBox:
if frm.Components[i] is TCombobox then
iniWork.WriteString(frm.Name, TCombobox(frm.Components[i]).Name, TCombobox(frm.Components[i]).Text)
else
and the following to load the TComboBox setting:
if frm.Components[i] is TCombobox then
begin
TCombobox(frm.Components[i]).ItemIndex := TCombobox(frm.Components[i]).Items.IndexOf(
iniWork.ReadString(frm.Name, TCombobox(frm.Components[i]).Name, TCombobox(frm.Components[i]).Text));
end
With the above code it looks to me like the setting is being save from and loaded back into the TComboBox's Text property. Now when the TComboBox setting is loaded, the form is changed after it has been created and placed, as an object, into the tmp TStringList list and prior to being shown modally. Yet, when the form is shown the Text property, as set by the above load code above, is shown.
It is because of the above that I am confused. Why does it work at this point, after the form is created. Yet not when the form is created?
This is a drop down list because you set the style to csDropDownList. That means that the edit control of the combo box can only display items that are contained in its list control.
For a drop down list combo, setting the Text property has no effect. Instead of using the Text property, you should be specifying ItemIndex.

Minimize the whole application when a child modal form is minimized

In another question near this, i get the answer to get modal forms to keep inside a workarea inside the mainform.
The way i can accomplish that (thanks to David again) is catching WMSizing, WMMoving, WMGetMaxMinInfo, and for my porpuose WMShowwindow messages.
I am not closed to messages handling and i think it is likely the way i manage messages the cause that i am not getting the result i needed.
All the forms in my application are modal. But you can open a lot in the same execution thread. (Mainform, form1, form2, form3... formN).
All form(1..N) move inside a workarea in my mainform. Maximize, restore, size, move... all between limits of that workarea.
But i cannot manage how to minimize the whole application from then click on active modal form minimize button, and from click on taskbar button.
The application will be used in XP and W7... i am developing in DelphiXE.
The project can be downloaded from here (Project files - Mainform, panel, button, SecondaryForm, unit, nothing more), just to see that i try all the suggestions i found before asking here.
This is the source code of the original unit that keeps the modal forms inside the workarea.
unit uFormularios;
interface
uses Classes, SysUtils, Windows, Messages, Forms, DBGrids, StdCtrls, Menus, Graphics, ComCtrls, Math;
type
TForm_en_ventana = class(TForm)
private
inicializada: boolean;
bCentrada : boolean;
bMaximizada : boolean;
ancho_original: integer;
alto_original : integer;
procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
procedure WMSizing(var msg: TMessage); message WM_SIZING;
procedure WMMoving(Var msg: TMessage); message WM_MOVING;
procedure WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
constructor Create(AOwner: TComponent); override;
property centrada: boolean read bCentrada write bCentrada;
property maximizada: boolean read bMaximizada write bMaximizada;
end;
procedure MaximizarFormulario(var F; MaximaAltura: integer = 0; MaximoAncho: integer = 0; Centrado: boolean = TRUE);
procedure InicializarVentanaTrabajo(const izq, der, arr, aba: integer);
var
ESPACIO_DE_TRABAJO, VENTANA_DE_TRABAJO: TRect;
implementation
constructor TForm_en_ventana.Create(AOwner: TComponent);
begin
inherited;
centrada := TRUE;
maximizada := false;
inicializada := false;
end;
Procedure TForm_en_ventana.WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo);
begin
inherited;
with msg.MinMaxInfo^.ptMaxPosition do
begin
x := VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMaxSize do
begin
x := VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMaxTrackSize do
begin
x := VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMinTrackSize do
begin
x := ancho_original;
y := alto_original;
end;
end;
procedure TForm_en_ventana.WMSizing(var msg: TMessage);
var
R: PRect;
begin
R := PRect(msg.LParam);
R.Left := Max(R.Left, VENTANA_DE_TRABAJO.Left);
R.Right := Min(R.Right, VENTANA_DE_TRABAJO.Right);
R.Top := Max(R.Top, VENTANA_DE_TRABAJO.Top);
R.Bottom := Min(R.Bottom, VENTANA_DE_TRABAJO.Bottom);
Caption := 'Ancho: ' + inttostr(ancho_original) + ' - Alto: ' + inttostr(alto_original);
end;
procedure TForm_en_ventana.WMMoving(var msg: TMessage);
var
R : PRect;
dx, dy: integer;
begin
R := PRect(msg.LParam);
dx := 0;
dy := 0;
if R.Left < VENTANA_DE_TRABAJO.Left then
dx := VENTANA_DE_TRABAJO.Left - R.Left;
if R.Right > VENTANA_DE_TRABAJO.Right then
dx := VENTANA_DE_TRABAJO.Right - R.Right;
if R.Top < VENTANA_DE_TRABAJO.Top then
dy := VENTANA_DE_TRABAJO.Top - R.Top;
if R.Bottom > VENTANA_DE_TRABAJO.Bottom then
dy := VENTANA_DE_TRABAJO.Bottom - R.Bottom;
OffsetRect(R^, dx, dy);
end;
procedure TForm_en_ventana.WMShowWindow(var Message: TWMShowWindow);
begin
if inicializada then
Exit;
inicializada := TRUE;
ancho_original := Width;
alto_original := Height;
Constraints.MinHeight := Height;
Constraints.MinWidth := Width;
if centrada then
begin
Left := (((VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left) - Width) div 2) + VENTANA_DE_TRABAJO.Left;
Top := (((VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top) - Height) div 2) + VENTANA_DE_TRABAJO.Top;
end;
if maximizada then
SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
end;
procedure InicializarVentanaTrabajo(const izq, der, arr, aba: integer);
begin
VENTANA_DE_TRABAJO.Left := izq;
VENTANA_DE_TRABAJO.Right := der;
VENTANA_DE_TRABAJO.Top := arr;
VENTANA_DE_TRABAJO.Bottom := aba;
end;
procedure MaximizarFormulario(var F; MaximaAltura: integer = 0; MaximoAncho: integer = 0; Centrado: boolean = TRUE);
begin
LockWindowUpdate(TForm(F).Handle);
TForm(F).Left := ESPACIO_DE_TRABAJO.Left;
if MaximoAncho = 0 then
TForm(F).Width := ESPACIO_DE_TRABAJO.Right
else
begin
if ESPACIO_DE_TRABAJO.Right < MaximoAncho then
TForm(F).Width := ESPACIO_DE_TRABAJO.Right
else
TForm(F).Width := MaximoAncho;
end;
TForm(F).Top := ESPACIO_DE_TRABAJO.Top;
if MaximaAltura = 0 then
TForm(F).Height := ESPACIO_DE_TRABAJO.Bottom
else
begin
if ESPACIO_DE_TRABAJO.Bottom < MaximaAltura then
TForm(F).Height := ESPACIO_DE_TRABAJO.Bottom
else
TForm(F).Height := MaximaAltura;
end;
if ((MaximoAncho <> 0) or (MaximaAltura <> 0)) and (Centrado) then
begin
TForm(F).Left := (ESPACIO_DE_TRABAJO.Right - TForm(F).Width) div 2;
TForm(F).Top := (ESPACIO_DE_TRABAJO.Bottom - TForm(F).Height) div 2;
end;
LockWindowUpdate(0);
end;
initialization
SystemParametersInfo(SPI_GETWORKAREA, 0, #ESPACIO_DE_TRABAJO, 0);
VENTANA_DE_TRABAJO := ESPACIO_DE_TRABAJO;
end.
Thanks to anybody who can help me!
I needed this too, and I tried the other answer but it's not working. Fortunately I managed to make it work, like this:
procedure TFoodsForm.WMSysCommand(var Msg: TWMSysCommand);
begin
if (fsModal in FormState) and (Msg.CmdType and $FFF0 = SC_MINIMIZE)
then Application.MainForm.WindowState:= wsMinimized
else inherited;
end;
Simply catch the Minimize and Restore messages in the Modal Form and do this ...
procedure TTheModalForm.WMSysCommand(var Msg: TWMSysCommand);
begin
if (fsModal in FormState) or not Application.MainForm.Visible then
begin
case Msg.CmdType of
SC_MINIMIZE:
begin
ShowWindow(Application.Handle, SW_SHOWMINNOACTIVE);
end;
SC_RESTORE:
begin
ShowWindow(Application.Handle, SW_SHOWNORMAL);
inherited;
end;
else
inherited;
end;
end
else
inherited;
end;
Thank you, JFGravel! This worked great for me, but I could never get the SC_RESTORE to get caught here, but restore works fine without, so here's my short version:
if (Message.CmdType and $FFF0) = SC_MINIMIZE then
ShowWindow(Application.Handle, SW_SHOWMINNOACTIVE)
else
inherited;