I have such a code
Label1.Caption := '';
Label2.Caption := '';
Label3.Caption := '';
Label4.Caption := '';
Label5.Caption := '';
Label6.Caption := '';
How can I make a loop or sth to make it shorter?
Make simple procedure to work on array of labels:
procedure ClearLabels(LabelsArr: array of TLabel);
var
i: Integer;
begin
for i := Low(LabelsArr) to High(LabelsArr) do
LabelsArr[i].Caption := '';
end;
and call it like that:
ClearLabels([Label1, Label2, Label3]);
Related
I am using this code to read emails from the server and it work except that Sender.Address and Body.Text are empty why is that ?. Here is the code:
var
MsgCount : Integer;
i : Integer;
FMailMessage : TIdMessage;
begin
Memo1.Lines.Clear;
//The IdPop31 is on the form so it is constructing when the
//form is created and so is Memo1.
IdPOP31.Host := 'server.com'; //Setting the HostName;
IdPOP31.Username := 'email#server.com';//Setting UserName;
IdPOP31.Password := 'xxxxxx';//Setting Password;
IdPOP31.Port := 110;//Setting Port;
try
IdPOP31.Connect();
//Getting the number of the messages that server has.
MsgCount := IdPOP31.CheckMessages;
for i:= 1 to Pred(MsgCount) do
begin
try
FMailMessage := TIdMessage.Create(nil);
IdPOP31.Retrieve(i,FMailMessage);
Memo1.Lines.Add('=================================================');
Memo1.Lines.Add(FMailMessage.From.Address);
Memo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
Memo1.Lines.Add(FMailMessage.Subject);
Memo1.Lines.Add(FMailMessage.Sender.Address);
Memo1.Lines.Add(FMailMessage.Body.Text);
Memo1.Lines.Add('=================================================');
finally
FMailMessage.Free;
end;
end;
finally
IdPOP31.Disconnect;
end;
end;
The TIdMessage.Sender is populated only if the email has a top-level Sender header, which is rare. Typically the sender is in the From header instead.
The body content will be stored in either the TIdMessage.Body or TIdMessage.MessageParts, depending on how the email is encoded. Typically, multi-piece emails, such as those encoded with MIME, especially if they contain attachments, will use TIdMessage.MessageParts, whereas simple emails, like plaintext-only emails, will use TIdMessage.Body. So, you need to check both as needed.
For example:
var
MsgCount, I: Integer;
FMailMessage: TIdMessage;
Body: TStrings;
function FindTextBody(AParent: Integer): TStrings;
var
J: integer;
Part: TIdMessagePart;
begin
Result := nil;
// MIME parts are ordered from least complex to most complex, and can be nested,
// so loop backwards through the parts, recursing through nested levels as needed...
for J := Pred(FMailMessage.MessageParts.Count) downto (AParent+1) do
begin
Part := FMailMessage.MessageParts[J];
if Part.ParentPart = AParent then
begin
if IsHeaderMediaType(Part.ContentType, 'multipart') then
begin
Result := FindTextBody(Part.Index);
if Result <> nil then Exit;
end
else if IsHeaderMediaType(Part.ContentType, 'text') then
begin
Result := (Part as TIdText).Body;
Exit;
end;
end;
end;
end;
begin
Memo1.Lines.Clear;
//The IdPop31 is on the form so it is constructing when the
//form is created and so is Memo1.
IdPOP31.Host := 'server.com'; //Setting the HostName;
IdPOP31.Username := 'email#server.com';//Setting UserName;
IdPOP31.Password := 'xxxxxx';//Setting Password;
IdPOP31.Port := 110;//Setting Port;
try
IdPOP31.Connect();
//Getting the number of the messages that server has.
MsgCount := IdPOP31.CheckMessages;
for I := 1 to Pred(MsgCount) do
begin
FMailMessage := TIdMessage.Create(nil);
try
IdPOP31.Retrieve(I, FMailMessage);
Memo1.Lines.Add('=================================================');
Memo1.Lines.Add(FMailMessage.From.Address);
Memo1.Lines.Add(FMailMessage.Recipients.EMailAddresses);
Memo1.Lines.Add(FMailMessage.Subject);
Memo1.Lines.Add(FMailMessage.Sender.Address);
if FMailMessage.MessageParts.Count > 0 then
Body := FindTextBody(-1)
else
Body := FMailMessage.Body;
if Body <> nil then
Memo1.Lines.Add(Body.Text);
Memo1.Lines.Add('=================================================');
finally
FMailMessage.Free;
end;
end;
finally
IdPOP31.Disconnect;
end;
end;
Here is how I am creating My PageControl.
PageCtrlSub := TPageControl.Create(Self);
PageCtrlSub.Parent := GroupSub;
PageCtrlSub.Align := alClient;
SubFormCnt := 0;
TblOdSub.First;
while not TblOdSub.Eof do
begin
SubPartNo := TblOdSub.FieldByName('sub_part_no').AsString;
AddNewSubTab(SubPartNo,Prc1Rs);
TblOdSub.Next;
end;
Here is how I am Creating my TabSheet and Form on the tabSheet.
procedure TFrmSub.AddNewSubTab(PartNo : String; PrcRs : TPriceRec);
var
i : Integer;
begin
inc(SubFormCnt);
TabSheet := TTabSheet.Create(PageCtrlSub);
TabSheet.Caption := 'Sub '+ intToStr(SubFormCnt);
TabSheet.PageControl := PageCtrlSub;
Form := TFrmSubExchange.Create(Self);
Form.Name := 'SForm' + IntToStr(SubFormCnt);
Form.Parent := TabSheet;
for i := 0 to Componentcount-1 do
begin
if (Components[i] is TFrmSubExchange) and (Components[i].Name = 'SForm' + IntToStr(SubFormCnt)) then
TFrmSubExchange(Components[i]).DataChangedSub(PartNo, PrcRs);
end;
Form.Show;
end;
I have a TCaption on each form that is created. When the user changes tab and press a button I need to know the text stored in the TCaption.caption property on the form of the active tab?
Thanks in Advance
Without seeing the DFM for TFrmSubExchange, this is just a guess, but you can try something like this:
procedure TFrmSub.SomeButtonClick(Sender: TObject);
var
s: string;
begin
s := (PageCtrlSub.ActivePage.Controls[0] as TFrmSubExchange).Caption1.Caption;
...
end;
EDIT:
Im having to edit some old Pascal Script in Fast Reports and are having a tough time returning only distinct records. Any help would be appreciated.
So Basically, I am calling a stored proc to return data in a table. In one of these columns there sometimes are a 1 letter code (A,B,C) that defines which rtf file to go fetch for the report.
Currently It does go fetch all of the rtf files for the respective codes, but sometimes the code is repeated (A,A) and in that case I need it to return only the DISTINCT rtf files. So If A was pulled allready, Dont Pull again and carry on looking for other codes in that Column
My Code:
NOTE: In Memo93 I am just inserting (table."Class")
procedure GroupHeader17OnBeforePrint(Sender: TfrxComponent );
var
CarGroup: String ;
CarGroupLoop: String;
begin
CarGroup := Memo93.Value;
if not(CarGroup = CarGroupLoop) then
begin
try
GroupHeader17.Visible := TRUE;
rich23.richedit.lines.LoadFromFile('example\'+ trim(Get('#QteLanguage'))+ '\'+ trim(Get('#QteLanguage'))+'_Group_'+ trim(<Table."class">)+ '.rtf');
except
GroupHeader17.Visible := FALSE;
end;
end
else
begin
GroupHeader17.Visible := False;
end;
CarGroupLoop := <table."Class">;
end;
This Seem to have done the job and only bring back distinct rtf files.
procedure GroupHeader17OnBeforePrint(Sender: TfrxComponent );
var
CarGroup: String ;
CarGroupLoop: String;
begin
CarGroup := Memo93.Value;
CarGroupLoop := <table."Class">;
if not(CarGroup = CarGroupLoop) then
begin
try
GroupHeader17.Visible := TRUE;
rich23.richedit.lines.LoadFromFile('example\'+ trim(Get('#QteLanguage'))+ '\'+ trim(Get('#QteLanguage'))+'_Group_'+ trim( <table."Class">)+ '.rtf');
except
GroupHeader17.Visible := FALSE;
end;
end
else
begin
GroupHeader17.Visible := False;
end;
end;
Try to use CarGroup := <table."Class">; and move CarGroupLoop := <table."Class">; at the end of GroupHeader17OnBeforePrint event
procedure GroupHeader17OnBeforePrint(Sender: TfrxComponent );
var
CarGroup: String ;
CarGroupLoop: String;
begin
CarGroup := <table."Class">;
if not(CarGroup = CarGroupLoop) then
begin
try
GroupHeader17.Visible := TRUE;
rich23.richedit.lines.LoadFromFile('example\'+ trim(Get('#QteLanguage'))+ '\'+ trim(Get('#QteLanguage'))+'_Group_'+ trim(<Table."class">)+ '.rtf');
except
GroupHeader17.Visible := FALSE;
end;
end
else
begin
GroupHeader17.Visible := False;
end;
CarGroupLoop := <table."Class">;
end;
Try
var CarGroup: String; //global variable
procedure GroupHeader17OnBeforePrint(Sender: TfrxComponent);
var CarGroupLoop: String ;
begin
CarGroupLoop := trim(<rpt_1_RHINO_Costing_Curr_Totals."SupplierClassCodeTransport">);
if not(CarGroup = CarGroupLoop) then
begin
try
//rich23.richedit.lines.LoadFromFile('D:\Data\Shares\GlobeTrackNew\QuoteInfo\Suppliers\Bidvest\'+ trim(Get('#QteLanguage'))+ '\'+ trim(Get('#QteLanguage'))+'_Group_'+ trim(<rpt_1_RHINO_Costing_Curr_Totals."SupplierClassCodeTransport">)+ '.rtf');
GroupHeader17.Visible := TRUE;
//rich23.richedit.lines.LoadFromFile('D:\Data\Shares\GlobeTrackNew\QuoteInfo\Suppliers\Bidvest\GER\GER_Group_I.rtf');
except
GroupHeader17.Visible := FALSE;
end;
end
else
GroupHeader17.Visible := FALSE;
CarGroup := trim(<rpt_1_RHINO_Costing_Curr_Totals."SupplierClassCodeTransport">);
end;
procedure SubCarHireOnBeforePrint(Sender: TfrxComponent);
begin
CarGroup := '';
end;
I have code that creates summary footers at runtime for numeric columns, but I can't get the group summary results to show. I've looked at How to create group summaries at runtime and How to set group summary values and How can create summary footer on runtime? but I'm hitting runtime error:
EcxInvalidDataControllerOperation with message 'RecordIndex out of range'
when the grid is rendering.
This code accepts any TcxGridDBTableView so it would be very easy to put into an existing Delphi form.
procedure SummaryGroup(ASummary: TcxDataSummary; AColumn: TcxGridDBColumn;
AKind: TcxSummaryKind; AFormat: string);
var
sumGroup: TcxDataSummaryGroup;
link: TcxGridTableSummaryGroupItemLink; //TcxDataSummaryGroupItemLink;
item: TcxGridDBTableSummaryItem;
begin
AColumn.Summary.FooterKind := AKind;
AColumn.Summary.FooterFormat := AFormat;
sumGroup := ASummary.SummaryGroups.Add;
link := sumGroup.Links.Add as TcxGridTableSummaryGroupItemLink;
link.Column := AColumn;
item := sumGroup.SummaryItems.Add as TcxGridDBTableSummaryItem;
item.Column := AColumn;
item.Kind := AKind;
item.Position := spGroup;
item.Format := AColumn.Summary.FooterFormat;
end;
procedure AutoAwesum(AView: TcxGridDBTableView);
var
summary: TcxDataSummary;
summing: Boolean;
i: Integer;
dc: TcxGridDBDataController;
col: TcxGridDBColumn;
begin
dc := AView.DataController;
summing := False;
summary := dc.Summary;
summary.BeginUpdate;
try
summary.SummaryGroups.Clear;
dc.BeginFullUpdate;
try
dc.GridView.ClearItems;
dc.CreateAllItems;
for i := 1 to AView.ColumnCount - 1 do
begin
col := AView.Columns[i];
case col.DataBinding.Field.DataType of
ftSmallint, ftInteger, ftWord, ftLargeint, ftAutoInc,
ftLongWord, ftShortint:
begin
summing := true;
SummaryGroup(summary, col, skSum, '#');
end;
ftFloat, ftBCD, ftFMTBcd, ftExtended, ftSingle:
begin
summing := true;
SummaryGroup(summary, col, skSum, '#.##');
end;
ftCurrency:
begin
summing := true;
SummaryGroup(summary, col, skSum, '$#.##');
end;
end;
end;
dc.DataModeController.GridMode := not summing;
AView.OptionsView.Footer := summing;
AView.OptionsView.GroupFooterMultiSummaries := summing;
AView.OptionsView.GroupFooters := gfVisibleWhenExpanded;
finally
dc.EndFullUpdate;
end;
finally
summary.EndUpdate;
end;
end;
What am I missing? Thanks.
Finally had a chance to get back to this. As expected, the changes were few and simple. Here's the code that generically creates group summary headers for each numeric column in a grid. I've left some options commented out in the code that you may want to use.
uses
cxGridDBDataDefinitions;
procedure Summarize(ASummary: TcxDataSummary; AColumn: TcxGridDBColumn;
AKind: TcxSummaryKind; AFormat: string);
var
sumGroup: TcxDataSummaryGroup;
link: TcxGridTableSummaryGroupItemLink;
item: TcxGridDBTableSummaryItem;
begin
AColumn.Summary.FooterKind := AKind;
AColumn.Summary.FooterFormat := AFormat;
AColumn.Summary.GroupKind := AKind;
AColumn.Summary.GroupFormat := AFormat;
AColumn.GroupIndex := -1;
sumGroup := ASummary.SummaryGroups.Add;
link := sumGroup.Links.Add as TcxGridTableSummaryGroupItemLink;
link.Column := AColumn;
item := sumGroup.SummaryItems.Add as TcxGridDBTableSummaryItem;
item.Column := AColumn;
item.Kind := skSum;
item.Position := spGroup;
item.Format := AColumn.Summary.FooterFormat;
end;
procedure AutoAwesum(AView: TcxGridDBTableView);
var
summary: TcxDataSummary;
summing: Boolean;
i: Integer;
dc: TcxGridDBDataController;
col: TcxGridDBColumn;
begin
dc := AView.DataController;
summing := False;
summary := dc.Summary;
summary.BeginUpdate;
try
summary.SummaryGroups.Clear;
dc.BeginFullUpdate;
try
dc.GridView.ClearItems;
dc.CreateAllItems;
for i := 1 to AView.ColumnCount - 1 do
begin
col := AView.Columns[i];
case col.DataBinding.Field.DataType of
ftSmallint, ftInteger, ftWord, ftLargeint, ftAutoInc,
ftLongWord, ftShortint:
begin
summing := true;
Summarize(summary, col, skSum, ',0');
end;
ftFloat, ftBCD, ftFMTBcd, ftExtended, ftSingle:
begin
summing := true;
Summarize(summary, col, skSum, ',.00');
end;
ftCurrency:
begin
summing := true;
Summarize(summary, col, skSum, '$,0.00');
end;
end;
end;
// dc.DataModeController.GridMode := not summing;
// AView.OptionsView.Header := summing;
AView.OptionsView.Footer := summing;
// AView.OptionsView.GroupFooterMultiSummaries := summing;
// AView.OptionsView.GroupFooters := gfVisibleWhenExpanded;
finally
dc.EndFullUpdate;
end;
finally
summary.EndUpdate;
end;
end;
I want to check and see if the TEdit.text is in this format 123/45/678 When text was entered
Thus ###/##/###
any simple way to do this?
thanks
Function CheckStringWithMask(const Str,Mask:String):Boolean;
var
i:Integer;
begin
Result := true;
if length(str)=length(Mask) then
begin
i := 0;
While Result and (I < Length(Str)) do
begin
inc(i);
Result := Result and (Str[i] <> '#')
and ((Mask[i] ='#') and (CharInSet(Str[i],['0'..'9']))
or (Str[i]=Mask[i]));
end;
end
else Result := false;
end;
Assuming your mask is so simple that it only has # and / it's easy to write a test function:
function MatchesMask(const Text, Mask: string): Boolean;
var
i: Integer;
begin
Result := False;
if Length(Text)<>Length(Mask) then
exit;
for i := 1 to Length(Text) do
case Mask[i] of
'#':
if (Text[i]<'0') or (Text[i]>'9') then
exit;
else
if Text[i]<>Mask[i] then
exit;
end;
Result := True;
end;
A variation on #David Heffernan's suggestion:
function MatchesMask(const Text, Mask: string): Boolean;
var
i: Integer;
begin
Result := (Length(Text) = Length(Mask));
if not Result then Exit;
i := 0;
while Result and (i < Length(Text)) do begin
Inc(i);
case Mask[i] of
'#':
Result := (Text[i] >= '0') and (Text[i] <= '9');
else
Result := (Text[i] = Mask[i]);
end;
end;
end;