Delphi and Interbase – Basic Website Solutions

September 17, 2024

Delphi Buttons – Create an hour glass impression while waiting

Got a chance to receive source code from a software vendor and the button on this program made me smile.

Haven’t though of it that way. But i think it works.

procedure TSFTPClientFrame.btConnectSSHClick(Sender: TObject);
var
  OldCursor: TCursor;
begin
  OldCursor := Screen.Cursor;
  try
    Screen.Cursor := crHourGlass;
    ScSSHClient.Connect;
  finally
    Screen.Cursor := OldCursor;
  end;
end;

The hour glass cursor is within the try row. Once it is done, it revert backs the cursor to the original one used. Pretty awesome.

Just wanted to share

Coffee Cup

August 31, 2024

Delphi Tip : How to get the value from TQrExpr Quick Report Component [solved]

Hi guys,

Just wanted to post this quick tip for those who are still using Delphi and wanted to get the value whether double or int when computing using TQrEXPR.

I remember already seeing this before and now I might need to post it here for posterity sake.

Hope it helps someone else out there. The concept is QREXPR1.Value.DblResult or IntResult.

case QRExpr1.Value.Kind of
resInt : Total := QRExpr1.Value.IntResult;
resDouble : Total := QRExpr1.Value.DblResult;
else
Total := 0.00;

Yeah it’s that easy.

Take care and stay safe

Coffee Cup

June 20, 2023June 20, 2023

Delphi 6 + QuickReport – Removing or Disabling the Save and Load Buttons during preview [solved]

This has been an age old question that one needs to tackle if you have clients that want to control data coming in and out of the company.

That is why I am quite happy and relieved to have found it as well.

Without further adue, here it is

uses
, QRPrntr, QRPrev;

procedure TqrpLabelGrader.QuickRep1Preview(Sender: TObject);
var
  qrStandardPreview: TQRStandardPreview;
begin
  //, QRPrntr, QRPrev;
  qrStandardPreview:=TQRStandardPreview.CreatePreview(Self, TQRPrinter(Sender));
  qrStandardPreview.SaveReport.Enabled := False;
  qrStandardPreview.LoadReport.Enabled := False;
  qrStandardPreview.Show;
end;

Enjoy

Coffee Cup

June 6, 2023June 6, 2023

Delphi 6 : using scroll in a DBGrid with WheelMouse

There was a request to make the mouse wheel as the scrolling. I found the code and wanted to save it as well here.

Enjoy

Coffee Cup

//with delphi7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, DB, DBTables;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    Table1: TTable;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TWheelDBGrid = class(TDBGrid)
  public
    property OnMouseWheel;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  TWheelDBGrid(DBGrid1).OnMouseWheel := DBGridMouseWheel;
end;

function GetNumScrollLines: Integer;
begin
  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);
end;

procedure TForm1.DBGridMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  Direction: Shortint;
begin
  Direction := 1;
  if WheelDelta = 0 then
    Exit
  else if WheelDelta > 0 then
    Direction := -1;

  with TDBGrid(Sender) do
  begin
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
      DataSource.DataSet.MoveBy(Direction * GetNumScrollLines);
    Invalidate;
  end;
end;

end.

https://www.swissdelphicenter.ch/en/showcode.php?id=2142

May 29, 2023May 29, 2023

Delphi Internal Error LA33 and RLink32.dll – Finally Found Out Why [SOLVED]

When doing Delphi App i encounter LA33 and RLink32 error which causes the app to crash during compiling. Sometimes I get away with being able to compile the EXE on some days, but other days, it just won’t do.

Access violation at address 062B487B in module RLINK32.DLL. Read of address 0C5DOD4A.

I researched and encountered the following solutions

Remove the .res file of your application. This would result in loosing your icon file. So when i do this step, i need to re-attach the icon file again.
Removing the .dcu files from your application. This sometimes work from me but a lot of times, it doesn’t as well.
I had increased the ram of my pc since when i read it, it was a memory problem. So far it sped up my pc but still the problem persists.

I had researched the issue again and found out a very small link that had the same problem as mine that might not exists in a lot of other developers out there. You see, my application is branched out to different companies under the same industry.

Let me explain, so if you have 3 companies buying-and-selling, i would create a single application that is saved 3 times in the same folder. So we have company1.exe, company2.exe and company3.exe.

As it turns out in the project file of the app, when the system uses the word {$R *.res} it tries to read the .res file fo the project. Since i had 3 of them, it made the compiler dizzy which one to choose. So when i erased the .res file before it sort of worked for a while

This is the solution. In the project unit, please change the line to {$R FileName.res} where the FileName is the name of the exe you are creating.

So instead of using {$R *.res} , please write {$R company1.res}

This is the original reply from one of the posts that i found. Thank you Lepe.

This error usually occurs when we save the project 2 times in the same folder with different names, in which case 2 files are created Resource:

Project1.res
MyApplication.res

I've ever had problems like that, and I solved it like this, although now I test with bds2006 and I don't get any warning .

Enjoy

Coffee Cup

https://www.clubdelphi.com/foros/showthread.php?t=50948

May 28, 2023May 28, 2023

Dephi and Quickreport and you want to close the quickreport after printing [SOLVED]

Hi guys, just wanted to share a quicky solution for an age old problem of closing the quickreport after clicking the print button.

This feature allows the system to record all report generated report by the user without allowing them to reprint the same report again if the preview report is seen on the screen.

There are 2 parts to this solutions. 1 is function that will be called. 2 is the function to be called during the afterprint procedure in the quickreport

part 1 – function

procedure CloseAllReportPreviews;
var
  i: Integer;
begin
  try
    for i := Screen.FormCount - 1 downto 0 do
    if Screen.Forms[i].ClassName = 'TQRStandardPreview' then
    begin
      Screen.Forms[i].close;
    end;
  except
    ShowMessage('Please close all existing reports');
  end;
end;

part 2 – afterprint in quickreport

procedure TQuickReport.QuickRepAfterPrint(Sender: TObject);
begin
    CloseAllReportPreviews;
  end;
end;

Enjoy

Coffee Cup

May 26, 2023May 26, 2023

Delphi Quickreport Disabling Load and Save buttons [SOLVED]

A recent client of mine insisted that he wanted the app to remove the load and save button for the quickreports.

After searching for around 2 hours, i found the solution from mr.wu

So thank you mr.wu

Here is the code

another way can solve this problem.
(1)append
    uses  ...QRPrntr, QRPrev,...
(2)complete the OnPreview method for the QuickRep as following:
procedure TqrpLabelGrader.QuickRep1Preview(Sender: TObject);
var
  qrStandardPreview: TQRStandardPreview;
begin
  qrStandardPreview:=TQRStandardPreview.CreatePreview(Self, TQRPrinter(Sender));
  qrStandardPreview.SaveReport.Enabled := False;
  qrStandardPreview.LoadReport.Enabled := False;
  qrStandardPreview.Show;
end;
HPH,
wu yong

Enjoy

Coffee Cup

http://www.delphigroups.info/2/b2/390705.html

May 2, 2023May 2, 2023

Delphi Error – E2151 Could not load RLINK32.DLL

Delphi Error – E2152 Wrong or corrupted version of RLINK32.DLL

fatal error saying:
Internal Error LA30
Access violation at address 0A3CA3E5 in module ‘RLINK32.DLL’
Read of address 0C5C01F0

What steps you can do

Deleting .dcus and rebuilding all of your packages
removed all DCU, and .res files, and rebuilt,
third party component packages interfering

I hope you are helped by these suggestions. Drop me a line if you want to ask questions.

Enjoy

Coffee Cup

March 22, 2023March 22, 2023

Delphi Get Sales Summary by Month (January to December)

Another feature i hope there was shortcut to, but it seems i need to write it myself.

Just wanted to share it here

Coffee Cup


    VFROM = VYEAR || '-1-1';
    VTO = VYEAR || '-1-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT1 = 0;
    ELSE PAMT1 = VAMT;  

    /* /////////////////////////////// */



    /* IF FEB LESS THAN MARCH 1 - THERE IS FEB 28 AND FEB 29 */
    VFROM = VYEAR || '-2-1';
    VTO = VYEAR || '-3-1';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO < :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT2 = 0;
    ELSE PAMT2 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-3-1';
    VTO = VYEAR || '-3-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT3 = 0;
    ELSE PAMT3 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-4-1';
    VTO = VYEAR || '-4-30';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT4 = 0;
    ELSE PAMT4 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-5-1';
    VTO = VYEAR || '-5-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT5 = 0;
    ELSE PAMT5 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-6-1';
    VTO = VYEAR || '-6-30';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT6 = 0;
    ELSE PAMT6 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-7-1';
    VTO = VYEAR || '-7-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT7 = 0;
    ELSE PAMT7 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-8-1';
    VTO = VYEAR || '-8-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT8 = 0;
    ELSE PAMT8 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-9-1';
    VTO = VYEAR || '-9-30';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT9 = 0;
    ELSE PAMT9 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-10-1';
    VTO = VYEAR || '-10-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT10 = 0;
    ELSE PAMT10 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-11-1';
    VTO = VYEAR || '-11-30';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT11 = 0;
    ELSE PAMT11 = VAMT;  

    /* /////////////////////////////// */



    VFROM = VYEAR || '-12-1';
    VTO = VYEAR || '-12-31';

    SELECT SUM(Z.PAMT)
    FROM  PAYSLIP Z
    WHERE Z.PDATE_COMPUTE_FROM >= :VFROM AND Z.PDATE_COMPUTE_TO <= :VTO AND Z.EID = :VEID
    INTO :VAMT;  

    IF (VAMT IS NULL) THEN
         PAMT12 = 0;
    ELSE PAMT12 = VAMT;  

    /* /////////////////////////////// */

March 22, 2023March 22, 2023

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