Delphi Code to get the Next 6 months

This code is what i use to get the 6 months of the month. Including the parameter of February where we sometimes have a 28th or 29th day.

Just in case this code helps you, please drop us a line

Coffee Cup




   /* 2-16-2023 - CREATE SUMMARY */

  VYEAR = EXTRACT(YEAR FROM VDATEFROM);
  VMONTH = EXTRACT(MONTH FROM VDATEFROM);

  SAFROM1 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO1 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO1 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO1 = SATO1 - 1;
  SAMONTH1 = 0;


  VDATE = SATO1 + 1;
  VYEAR = EXTRACT(YEAR FROM VDATE);
  VMONTH = EXTRACT(MONTH FROM VDATE);

  SAFROM2 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO2 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO2 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO2 = SATO2 - 1;
  SAMONTH2 = 0;



  VDATE = SATO2 + 1;
  VYEAR = EXTRACT(YEAR FROM VDATE);
  VMONTH = EXTRACT(MONTH FROM VDATE);

  SAFROM3 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO3 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO3 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO3 = SATO3 - 1;
  SAMONTH3 = 0;



  VDATE = SATO3 + 1;
  VYEAR = EXTRACT(YEAR FROM VDATE);
  VMONTH = EXTRACT(MONTH FROM VDATE);

  SAFROM4 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO4 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO4 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO4 = SATO4 - 1;
  SAMONTH4 = 0;




  VDATE = SATO4 + 1;
  VYEAR = EXTRACT(YEAR FROM VDATE);
  VMONTH = EXTRACT(MONTH FROM VDATE);

  SAFROM5 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO5 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO5 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO5 = SATO5 - 1;
  SAMONTH5 = 0;



  VDATE = SATO5 + 1;
  VYEAR = EXTRACT(YEAR FROM VDATE);
  VMONTH = EXTRACT(MONTH FROM VDATE);

  SAFROM6 = VYEAR || '-' || VMONTH || '-1';
  IF (VMONTH = 12) THEN
  BEGIN
    VMONTH = 1;
    VYEAR =  VYEAR + 1;
    SATO6 = VYEAR || '-' || VMONTH || '-1';
  END
  ELSE 
  BEGIN 
    VMONTH = VMONTH + 1;
    SATO6 = VYEAR || '-' || VMONTH || '-1';
  END
  SATO6 = SATO6 - 1;
  SAMONTH6 = 0;

  SAOTHERS = 0;
  SAUNPAID = 0;

  SUSPEND;

   /* 2-16-2023 - CREATE SUMMARY */
















    /* 2-16-2023 - CREATE SUMMARY */
    VDATE = NULL;
    IF (OCCHECK_DATE IS NOT NULL) THEN
    BEGIN
      VDATE = OCCHECK_DATE;
    END
    IF (OMDATE IS NOT NULL) THEN
    BEGIN
      VDATE = OMDATE;
    END

    IF (VDATE IS NOT NULL) THEN
    BEGIN
      IF ((VDATE >= SAFROM1) AND (VDATE <= SATO1)) THEN
        SAMONTH1 = SAMONTH1 + CP_INVAMT;
      ELSE
      IF ((VDATE >= SAFROM2) AND (VDATE <= SATO2)) THEN
        SAMONTH2 = SAMONTH2 + CP_INVAMT;
      ELSE
      IF ((VDATE >= SAFROM3) AND (VDATE <= SATO3)) THEN
        SAMONTH3 = SAMONTH3 + CP_INVAMT;
      ELSE
      IF ((VDATE >= SAFROM4) AND (VDATE <= SATO4)) THEN
        SAMONTH4 = SAMONTH4 + CP_INVAMT;
      ELSE
      IF ((VDATE >= SAFROM5) AND (VDATE <= SATO5)) THEN
        SAMONTH5 = SAMONTH5 + CP_INVAMT;
      ELSE
      IF ((VDATE >= SAFROM6) AND (VDATE <= SATO6)) THEN
        SAMONTH6 = SAMONTH6 + CP_INVAMT;
      ELSE
        SAOTHERS = SAOTHERS + CP_INVAMT;
    END

Delphi + Excel OLE Manipulation (Change Font, Masking and More)

Delphi + Excel OLE

Thought of saving this one here. For those who still use delphi in 2023, here are the features you can access. Just in case you have questions or issues encountered, just drop me a line

Coffee Cup

...control Excel with OLE?
Autor: Thomas Stutz
[ Print tip ]	 	 

Tip Rating (503):	 
     

uses
  ComObj;

var
  ExcelApp: OleVariant;

implementation


procedure TForm1.Button1Click(Sender: TObject);
const
  // SheetType
  xlChart = -4109;
  xlWorksheet = -4167;
  // WBATemplate
  xlWBATWorksheet = -4167;
  xlWBATChart = -4109;
  // Page Setup
  xlPortrait = 1;
  xlLandscape = 2;
  xlPaperA4 = 9;
  // Format Cells
  xlBottom = -4107;
  xlLeft = -4131;
  xlRight = -4152;
  xlTop = -4160;
  // Text Alignment
  xlHAlignCenter = -4108;
  xlVAlignCenter = -4108;
  // Cell Borders
  xlThick = 4;
  xlThin = 2;
var
  ColumnRange: OleVariant;

  // Function to get the number of Rows in a Certain column

  function GetLastLine(AColumn: Integer): Integer;
  const
    xlUp = 3;
  begin
    Result := ExcelApp.Range[Char(96 + AColumn) + IntToStr(65536)].end[xlUp].Rows.Row;
  end;

begin
  { Start Excel }

  // By using GetActiveOleObject, you use an instance of Word that's already running,
  // if there is one.
  try
    ExcelApp := GetActiveOleObject('Excel.Application');
  except
    try
      // If no instance of Word is running, try to Create a new Excel Object
      ExcelApp := CreateOleObject('Excel.Application');
    except
      ShowMessage('Cannot start Excel/Excel not installed ?');
      Exit;
    end;
  end;

  // Add a new Workbook, Neue Arbeitsmappe ?ffnen
  ExcelApp.Workbooks.Add(xlWBatWorkSheet);

  // Open a Workbook, Arbeitsmappe ?ffnen
  ExcelApp.Workbooks.Open('c:\YourFileName.xls');


  // Rename the active Sheet
  ExcelApp.ActiveSheet.Name := 'This is Sheet 1';

  // Rename
  ExcelApp.Workbooks[1].WorkSheets[1].Name := 'This is Sheet 1';

  // Insert some Text in some Cells[Row,Col]
  ExcelApp.Cells[1, 1].Value := 'SwissDelphiCenter.ch';
  ExcelApp.Cells[2, 1].Value := 'http://www.swissdelphicenter.ch';
  ExcelApp.Cells[3, 1].Value := FormatDateTime('dd-mmm-yyyy', Now);

  // Setting a row of data with one call
  ExcelApp.Range['A2', 'D2'].Value := VarArrayOf([1, 10, 100, 1000]);

  // Setting a formula
  ExcelApp.Range['A11', 'A11'].Formula := '=Sum(A1:A10)';

  // Change Cell Alignement
  ExcelApp.Cells[2, 1].HorizontalAlignment := xlright;

  // Change the Column Width.
  ColumnRange := ExcelApp.Workbooks[1].WorkSheets[1].Columns;
  ColumnRange.Columns[1].ColumnWidth := 20;
  ColumnRange.Columns[2].ColumnWidth := 40;

  // Change Rowheight / Zeilenh?he ?ndern:
  ExcelApp.Rows[1].RowHeight := 15.75;

  // Merge cells, Zellen verbinden:
  ExcelApp.Range['B3:D3'].Mergecells := True;

  // Apply borders to cells, Zellen umrahmen:
  ExcelApp.Range['A14:M14'].Borders.Weight := xlThick; // Think line/ Dicke Linie
  ExcelApp.Range['A14:M14'].Borders.Weight := xlThin;  // Thin line D邦nne Linie

  // Set Bold Font in cells, Fettdruck in den Zellen

  ExcelApp.Range['B16:M26'].Font.Bold := True;

  // Set Font Size, Schriftgr??e setzen
  ExcelApp.Range['B16:M26'].Font.Size := 12;

  //right-aligned Text, rechtsb邦ndige Textausrichtung
  ExcelApp.Cells[9, 6].HorizontalAlignment := xlright;

  // horizontal-aligned text, horizontale Zentrierung
  ExcelApp.Range['B14:M26'].HorizontalAlignment := xlHAlignCenter;

  // left-aligned Text, vertikale Zentrierung
  ExcelApp.Range['B14:M26'].VerticallyAlignment := xlVAlignCenter;


  { Page Setup }

  ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape;

  // Left, Right Margin (Seitenr?nder)
  ExcelApp.ActiveSheet.PageSetup.LeftMargin  := 35;
  ExcelApp.ActiveSheet.PageSetup.RightMargin := -15;

  // Set Footer Margin
  ExcelApp.ActiveSheet.PageSetup.FooterMargin := ExcelApp.InchesToPoints(0);

  // Fit to X page(s) wide by Y tall
  ExcelApp.ActiveSheet.PageSetup.FitToPagesWide := 1;  // Y
  ExcelApp.ActiveSheet.PageSetup.FitToPagesTall := 3; // Y

  // Zoom
  ExcelApp.ActiveSheet.PageSetup.Zoom := 95;

  // Set Paper Size:
  ExcelApp.PageSetup.PaperSize := xlPaperA4;

  // Show/Hide Gridlines:
  ExcelApp.ActiveWindow.DisplayGridlines := False;

  // Set Black & White
  ExcelApp.ActiveSheet.PageSetup.BlackAndWhite := False;

  // footers
  ExcelApp.ActiveSheet.PageSetup.RightFooter := 'Right Footer / Rechte Fu?zeile';
  ExcelApp.ActiveSheet.PageSetup.LeftFooter  := 'Left Footer / Linke Fu?zeile';

  // Show Excel Version:
  ShowMessage(Format('Excel Version %s: ', [ExcelApp.Version]));

  // Show Excel:
  ExcelApp.Visible := True;

  // Save the Workbook
  ExcelApp.SaveAs('c:\filename.xls');

  // Save the active Workbook:
  ExcelApp.ActiveWorkBook.SaveAs('c:\filename.xls');

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  // Quit Excel
  if not VarIsEmpty(ExcelApp) then
  begin
    ExcelApp.DisplayAlerts := False;  // Discard unsaved files....
    ExcelApp.Quit;
  end;
end;

“Interface not supported” error when attempting to open Excel or Word from Delphi

Interface not supported

When using Delphi that outputs some text into Excel or Word, I encountered the error “Interface not supported” on one machine

The problem was that the previous version of Excel was uninstalled incorrectly on the machine. To fix it, I used these steps :

  1. Open the regedit editor.
  2. Open HKEY_CLASSES_ROOT >> TypeLib >> {00020813-0000-0000-C000-000000000046}

(The Excel PIA key is {00020813-0000-0000-C000-000000000046}) 

3. Delete the version that you don’t have. Leave only the version that you have instaled. In my case it was Excel 2010 which is 1.7. For Excel 2013 is 1.8, and for Excel 2016 is 1.9

Here are the version controls

Excel HKEY_CLASSES_ROOT\TypeLib{00020813-0000-0000-C000-000000000046}\

  • 1.7 is for Office 2010
  • 1.8 is for Office 2013
  • 1.9 is for Office 2016

Word HKEY_CLASSES_ROOT\TypeLib{00020905-0000-0000-C000-000000000046}\

  • 8.5 is for Office 2010
  • 8.6 is for Office 2013
  • 8.7 is for Office 2016

PowerPoint HKEY_CLASSES_ROOT\TypeLib{91493440-5A91-11CF-8700-00AA0060263B}\

  • 2.a is for Office 2010
  • 2.b is for Office 2013
  • 2.c is for Office 2016

Outlook HKEY_CLASSES_ROOT\TypeLib{00062FFF-0000-0000-C000-000000000046}\

  • 9.4 is for Office 2010
  • 9.5 is for Office 2013
  • 9.6 is for Office 2016

Hope it helps

Coffee Cup

Delphi 6 – Get Date From and Date To With Number of Days

So far I have recreated this code far more in the 16 years that I have been using Delphi. Just wanted to log it here so that when I need it again, it will be here.

Hope it can also help other people

Enjoy

Coffee Cup

procedure TfrmPassword.BitBtn1Click(Sender: TObject);
var
vWeekDay : String;
begin
//DateUtils
//get the first and last day
if (ALMONTH.VALUE <= 11) then
begin
ALFROM.VALUE := StrToDate( ALMONTH.Text + ‘/01/’ + ALYEAR.Text );
ALTO.VALUE := StrToDate( IntToStr(ALMONTH.VALUE + 1) + ‘/01/’ + ALYEAR.Text ) – 1;
end
else
begin
ALFROM.VALUE := StrToDate( ’12/01/’ + ALYEAR.Text );
ALTO.VALUE := StrToDate( ’01/01/’ + inttostr(ALYEAR.Value + 1) ) – 1;
end;
//loop the number of days
ALDAYS.VALUE := DaysBetween(ALTO.VALUE, ALFROM.VALUE) + 1;
ALDATE.VALUE := ALFROM.VALUE;
ALSUN.VALUE := 0;
ALTOTAL.Value := 0;
while (ALDATE.Value <= ALTO.Value) do
begin
vWeekDay := LongDayNames[DayOfWeek(ALDATE.Value)]; if (vWeekDay = 'Sunday') then ALSUN.VALUE := ALSUN.VALUE + 1 else ALTOTAL.Value := ALTOTAL.Value + 1; ALDATE.Value := ALDATE.Value + 1;
end;
end;

Delphi – Create a single instance of your app

Hi guys. After searching for a while on how to lock and limit the app clicking. And this is now possible.

Here is the code for the main project file

program Project2;

 

uses

Forms, Windows, Messages, Dialogs,

Unit1 in ‘Unit1.pas’ {Form1};

 

{$R *.res}

 

function CreateSingleInstance(const InstanceName: string): boolean;

var

MutexHandle: THandle;

begin

MutexHandle := CreateMutex(nil, false, PChar(InstanceName));

// if MutexHandle created check if already exists

if (MutexHandle <> 0) then

begin

if GetLastError = ERROR_ALREADY_EXISTS then

begin

Result := false;

CloseHandle(MutexHandle);

end

else Result := true;

end

else Result := false;

end;

 

var

MyInstanceName: string;

begin

MyInstanceName := ‘Project2’;

Application.Initialize;

// Initialize MyInstanceName here

if CreateSingleInstance(MyInstanceName) then

begin

// Form creation

Application.CreateForm(TForm1, Form1);

Application.Run;

end

else Application.Terminate;

end.

InterBase Database Maximum User Connections

I got this quote from the operational guide itself.

* Maximum number of clients connected to one server

There is no single number for the maximum number of clients the InterBase server can serve—it depends on a combination of factors including capability of the operating system, limitations of the hardware, and the demands that each client puts on the server.

OPERATIONAL GUIDE MAXIMUM USER CONNECTION
OPERATIONAL GUIDE MAXIMUM USER CONNECTION

 

Delphi : Open Excel File using ShellExecute

This is a nifty code that i use whenever I do excel conversions. It helps users by seeing the excel file and not have to look for the file once the system has generated the output file

ShellExecute(Handle, 'open', 'c:\MyDocuments\MyFile.doc',nil,nil,SW_SHOWNORMAL);

In this example, the file is located inside the ‘My Documents’ folder with the file name ‘MyFile.xls’. Just in case the file name you are using is dynamic, you can enclose the variable with a PChar.

ShellExecute(Handle, 'open', PChar(varMyFilename),nil,nil,SW_SHOWNORMAL) ;

Enjoy

Coffee Cup

Borland Database Engine (BDE) Config Disappears

Being a programmer for so many years, i have been accustomed to a adapt to different circumstances and scenarios. Here are my top reasons why Borland Database Engine (BDE) profiles seem to dissapear.

* Windows User Account Control Settings
Now this one is the first one on the list. When you modify the security level from medium to low, this is the first one in my list.

* Deepfreeze Software or Any Software that Restores Back Windows
This one is quite obvious. deepfreeze is a software that when you restart your pc, it reverts back to the way it was. Yeah, who knows, you might be a victim of one.

* Windows 10 Update
Now this one beats the cake. So far, when Windows downloads an update to yur pc, be sure that he meddled with the settings. Well, it’s a bit off topic but my system date and time, Windows keep setting it to automatically update. This feature i usually turn off because i set the time minutes advance.

I created a youtube video to show some pictures of what i mean

Enjoy

Coffee Cup

https://youtu.be/sAamLzyf_yk

Hyper Threading to Single Thread

If you are looking for a software that will bridge your delphi application and your interbase application that is freeware, look no further. I found this program while researching since i cannot install delphi during deployment because it needs a serial key. Now, you don’t need to.

Here are the links. Please try only one. They all link to the same file. But just in case one of the links fail, at least you have other options to reach them.

http://www.indishare.me/79wawf5nnord

http://verified-download.com/file/36L9866

https://uploadocean.com/4r1mzjqiz7fw

https://dailyuploads.net/8uksbvfx4apm

https://www.megaupload.us/1NlH/20180218_Interbase_Hyper_Threading_to_SIngle_Thread.7z

http://agileurbia.com/CVW

 

 

Interbase Server 6.01 IBServer601

If you are looking for a software that will bridge your delphi application and your interbase application that is freeware, look no further. I found this program while researching since i cannot install delphi during deployment because it needs a serial key. Now, you don’t need to.

Here are the links. Please try only one. They all link to the same file. But just in case one of the links fail, at least you have other options to reach them.

http://www.indishare.me/crwiuhtl4orc

http://reliablefiles.com/file/36L9867

https://uploadocean.com/4gc6yik3rkk3

https://dailyuploads.net/xiusw41u9hs2

https://www.megaupload.us/1NlI/20180218_Interbase_Server_6.01_IBServer601.7z

http://agileurbia.com/CX4