I wrote this redundant code consisting of 30 lines:
if Button = TMouseButton.mbLeft then
begin
if pnlEndColor.ShowCaption then
begin
pnlStartColor.ShowCaption := False;
pnlEndColor.ShowCaption := False;
pnlStartColor.Color := ThisColor;
pnlEndColor.Color := ThisColor;
end
else
begin
pnlStartColor.ShowCaption := False;
pnlStartColor.Color := ThisColor;
end;
end
else if Button = TMouseButton.mbRight then
begin
if pnlStartColor.ShowCaption then
begin
pnlStartColor.ShowCaption := False;
pnlEndColor.ShowCaption := False;
pnlStartColor.Color := ThisColor;
pnlEndColor.Color := ThisColor;
end
else
begin
pnlEndColor.ShowCaption := False;
pnlEndColor.Color := ThisColor;
end;
end;
I manually refactored the code by extracting it to a small method by applying just logic:
procedure TForm1.SetPanelColors(Panel1, Panel2: TPanel; const aColor: TColor);
begin
if Panel2.ShowCaption then
begin
Panel1.ShowCaption := False;
Panel2.ShowCaption := False;
Panel1.Color := aColor;
Panel2.Color := aColor;
end
else
begin
Panel1.ShowCaption := False;
Panel1.Color := aColor;
end;
end;
Then I used the method by these 4 lines of code (Savings of 26 lines compared to the previous redundant code):
if Button = TMouseButton.mbLeft then
SetPanelColors(pnlStartColor, pnlEndColor, ThisColor)
else
SetPanelColors(pnlEndColor, pnlStartColor, ThisColor);
How could such a refactoring of redundant code be automated? Are there any libraries or general resources for such a purpose?
Related
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;
Issue: I have two checkboxes (only one has to check at a time) and one edit box. For the both the checkboxes when they are checked, value in the edit box has to change to '0' otherwise original value will remain in the edit box. Below are the two onclick events for the two checkboxes. when I write chkFacetoFace.checked := false the respective onclick handler is called and I was unable to achieve the desired result. Can anyone please help me on resolving this issue ?
procedure TForm1.chkFacetoFaceClick(Sender: TObject);
begin
if chkFacetoFace.Checked then
begin
edtConvFee.Text := '0.00';
chkWaiveOff.Checked := False;
end
else
begin
edtConvFee.Text := '5.00';
end;
end;
procedure TForm1.chkWaiveOffClick(Sender: TObject);
begin
if chkWaiveOff.Checked then
begin
edtConvFee.Text := '0.00';
chkFacetoFace.Checked := False;
end
else
begin
edtConvFee.Text := '5.00';
end;
end;
As TLama commented:
You can temporarily unassign the OnClick handlers.
Value of EditBox.Text is set in not intended cases. You should check both Checkboxe's Checked states before changing EditBox.Text. See this example:
.
procedure TForm1.chkWaiveOffClick(Sender: TObject);
begin
if chkWaiveOff.Checked then
begin
edtConvFee.Text := '0.00';
chkFacetoFace.Checked := False;
end
else if not chkFaceToFace.Checked then // <-- additional check for the respective checkbox
begin
edtConvFee.Text := '5.00';
end;
end;
#David Heffernan said "Check box is wrong here."
try this:
procedure TForm1.chk1Click(Sender: TObject);
begin
inherited;
chk1.OnClick := nil;
chk2.OnClick := nil;
chk2.OnClick := nil;
if TCheckBox(Sender).Name = 'chk1' then
begin
chk2.Checked := False;
chk3.Checked := False;
end
else if TCheckBox(Sender).Name = 'chk2' then
begin
chk1.Checked := False;
chk3.Checked := False;
end
else if TCheckBox(Sender).Name = 'chk3' then
begin
chk1.Checked := False;
chk2.Checked := False;
end;
chk1.OnClick := chk1Click;
chk2.OnClick := chk1Click;
chk3.OnClick := chk1Click;
end;`
How do I create a UIPickerview in Delphi xe6 for iOS ? When making a selection for a combobox, a UI picker view will appear. How do I create a similar pickerview, but with more control over it? E.g., being able to place it anywhere on the form, customize it, not have to go through a combobox, etc. ?
I have found where in it's unit class where it is created.
FMX.Listbox
constructor TCustomComboBox.Create(AOwner: TComponent);
var
PickerService: IFMXPickerService;
begin
inherited;
if TPlatformServices.Current.SupportsPlatformService(IFMXPickerService, IInterface(PickerService)) then
begin
FListPicker := PickerService.CreateListPicker;
FListPicker.Parent := Self;
FListPicker.OnValueChanged := DoOnValueChangedFromDropDownList;
FListPicker.OnHide := DoClosePicker;
FListPicker.OnShow := DoPopup;
end;
FDropDownKind := TDropDownKind.Custom;
DropDownCount := 8;
FItemWidth := 0;
CanFocus := True;
FDroppedDown := False;
FPopup := TPopup.Create(Self);
FPopup.StyleLookup := 'combopopupstyle';
FPopup.PlacementTarget := Self;
FPopup.Stored := False;
FPopup.Parent := Self;
FPopup.Locked := True;
FPopup.DesignVisible := False;
FPopup.DragWithParent := True;
FPopup.OnClosePopup := DoClosePopup;
FPopup.OnPopup := DoPopup;
FListBox := CreateListBox;
FListBox.Parent := Popup;
FListBox.Stored := False;
FListBox.Align := TAlignLayout.Client;
FListBox.ShowCheckboxes := False;
FItemIndex := -1;
SetAcceptsControls(False);
DropDownKind := TDropDownKind.Native;
end;
I don't need the popup, so I then read about accessing properties and methods via a 'hack-ish' kind of way
Type
THackPicker = class(TCustomComboBox);
....
var
FListBox : TComboListBox;
begin
try
FListBox := THackPicker(FListBox).createListbox;
FListBox := TCustomComboBox.createListbox;
FListBox.Parent := Layout1;
FListBox.Stored := False;
FListBox.Align := TAlignLayout.Client;
FListBox.Items := ComboBox1.Items;
FListBox.OnClick := Button2Click;
except
on E : Exception do begin
showMessage(e.Message);
end;
end;
end;
App crashes here. I'm assuming this is not the correct way to go about it. Any help or direction would be much appreciated!
I am a delphi learner. I am having one Delphi Progect with "MainForm", "MinimizeTimer" and "RestoreTimer". I have defined the following codes.
Minimize Timer :
if MainForm.AlphaBlendValue >= 225 then
begin
MinimizeTimer.Enabled := true;
MainForm.AlphaBlendValue := MainForm.AlphaBlendValue - 5;
end;
Restore Timer :
if MainForm.AlphaBlendValue >= 0 then
begin
RestoreTimer.Enabled := true;
MainForm.AlphaBlendValue := MainForm.AlphaBlendValue + 5;
end;
My requirement is that the MainForm will be first fadeout using "MinimizeTimer" and then will be minimized when "_" Button on Caption Bar is pressed. And also be fadein using "RestoreTimer" and then will be restored after clicking on taskbar. So I defined again the following codes:
private
{ Private declarations }
procedure WMSysCommand(var Msg: TWMSysCommand) ; message WM_SYSCOMMAND;
..
..
..
..
..
procedure TMainForm.WMSysCommand(var Msg: TWMSysCommand) ;
begin
if Msg.CmdType = SC_MINIMIZE then MinimizeTimer.Enabled := true;
DefaultHandler(Msg);
if Msg.CmdType = SC_RESTORE then RestoreTimer.Enabled := true;
DefaultHandler(Msg);
end;
But I am not getting the expected result. The MainForm is Minimized and Restored as in regular way. Please remember in my project I have one "FormCloseQuery" event also.
Please help me.
You are using the wrong logic for your requirements. Try this instead:
procedure TMainForm.MinimizeTimerTimer(Sender: TObject);
begin
if AlphaBlendValue > 0 then
begin
AlphaBlendValue := AlphaBlendValue - 5;
end
else
begin
MinimizeTimer.Enabled := False;
Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
end;
procedure TMainForm.RestoreTimerTimer(Sender: TObject);
begin
if AlphaBlendValue < 255 then
begin
AlphaBlendValue := AlphaBlendValue + 5;
end else begin
RestoreTimer.Enabled := False;
end;
end;
procedure TMainForm.WMSysCommand(var Msg: TWMSysCommand);
begin
case Msg.CmdType of
SC_MINIMIZE: begin
if AlphaBlendValue > 0 then
begin
MinimizeTimer.Enabled := True;
Exit;
end;
end;
SC_RESTORE: begin
if AlphaBlendValue < 255 then begin
RestoreTimer.Enabled := True;
end;
end;
end;
inherited;
end;
I want to create a warning dialog box which asks the users if the information typed during signup was correct, and asks him wether he want to continue or close that dialog and correct his information.
var
td: TTaskDialog;
tb: TTaskDialogBaseButtonItem;
begin
td := TTaskDialog.Create(nil);
try
td.Caption := 'Warning';
td.Text := 'Continue or Close?';
td.MainIcon := tdiWarning;
td.CommonButtons := [];
tb := td.Buttons.Add;
tb.Caption := 'Continue';
tb.ModalResult := 100;
tb := td.Buttons.Add;
tb.Caption := 'Close';
tb.ModalResult := 101;
td.Execute;
if td.ModalResult = 100 then
ShowMessage('Continue')
else if td.ModalResult = 101 then
ShowMessage('Close');
finally
td.Free;
end;
end;
Note: This will only work on Windows Vista or later.
if delphi then
if mrYes=MessageDlg('Continue?',mtwarning,[mbYes, mbNo],0) then
begin
//do somthing
end
else
exit; //go out
var
AMsgDialog: TForm;
abutton: TButton;
bbutton: TButton;
begin
AMsgDialog := CreateMessageDialog('This is a test message.', mtWarning,[]);
abutton := TButton.Create(AMsgDialog);
bbutton := TButton.Create(AMsgDialog);
with AMsgDialog do
try
Caption := 'Dialog Title' ;
Height := 140;
AMsgDialog.Width := 260 ;
with abutton do
begin
Parent := AMsgDialog;
Caption := 'Continue';
Top := 67;
Left := 60;
// OnClick :tnotyfievent ;
end;
with bbutton do
begin
Parent := AMsgDialog;
Caption := 'Close';
Top := 67;
Left := 140;
//OnClick :tnotyfievent ;
end;
ShowModal ;
finally
abutton.Free;
bbutton.Free;
Free;
end;
Based on this:
procedure HookResourceString(rs: PResStringRec; newStr: PChar);
var
oldprotect: DWORD;
begin
VirtualProtect(rs, SizeOf(rs^), PAGE_EXECUTE_READWRITE, #oldProtect);
rs^.Identifier := Integer(newStr);
VirtualProtect(rs, SizeOf(rs^), oldProtect, #oldProtect);
end;
const
SContinue = 'Continue';
SClose = 'Close';
procedure TForm1.Button1Click(Sender: TObject);
begin
HookResourceString(#SMsgDlgOK, SContinue);
HookResourceString(#SMsgDlgCancel, SClose);
if MessageDlg('My Message', mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
begin
// OK...
end;
end;