1. Compile Date
2. Delay again!
3. A High Resolution timer for Most Win95 Systems
4. How do I run a program?
5. How to write text transparently on the canvas. using Textout
6. Different colors for the lines in the DBCtrlGrid
7. Overriding Virtual Methods
8. How to do a delay without using 100% CPU time?
9. SHAREWARE NAG EXAMPLE !!
10. Auto Scaling routine...

Compile Date

Martin Larsson <martin.larsson@delfi-data.msmail.telemax.no> wrote:

> It's very nice to have a number say in the about box that the
> customer can read you, and you can immediately find the version.
> Using date and time of compilation would be a good number.

I'm assuming you already do something like this, but for all those who haven't realised this workaround, write a program which outputs the current date to a text file and call it something like "today.inc". A DOS program works best ( run it from your autoexec.bat - takes no time at all ), or stick a windows prog in you startup group/folder.

"today.inc" will have the form -

const
      _day   : string[10] = 'Monday';
      _date  : word = 12;
      _month : word = 8;
      _year  : word = 1996;

Then, just do a {$I c:\today.inc} at the top of all your programs.

Easy, although I agree - {$DATE} would be easier!

Delay again!

From: Tim_Hyder@msn.com (Tim Hyder)

>Delays are still one of the major leaks in Delphi.
>I'm using delphi1 and looking for a 2 ms delay with an accuracy of >about
>-0 ms +1 ms error. Does anyone know something.
>A loop is not accurate enough. Timer component is 18.2 times/sec.

I Have included a module I have used when making some 16 bit screen savers. It has a global called DelayInit which is global and should made in your form create like this

DelayInit := False;
Delay(0);  {If delay NOT done then init}

This calibrates itself for the system.

unit Globals;

interface

Uses WinProcs, WinTypes, Messages,Classes, Graphics, IniFiles;

Const
  OT_USER = 1;

Var
  SsType : Integer;
{  iObjL  : Integer;  { Current Object LEFT position }
{  iObjR  : Integer;  { Current Object RIGHT position }
{  iObjT  : Integer;  { Current Object TOP position }

  Finish     : Boolean;
  TestMode   : Boolean;                                    { True if testing }
  LoopsMs    : LongInt;                                    { Ms loops }
  ScreenWd   : Integer;                                    { Screen width }
  ScreenHt   : Integer;                                    { Screen Height }

  SpotSize   : Integer;                                    { Spotlight Size }
  SpotSpeed  : Integer;                                    { Spotlight Speed }

  DelayInit  : Boolean;                                    { True if delay loop initiated }

Procedure Delay(Ms : Integer);                             { Delay for Ms Millsecs }

Procedure CursorOff;                                       { Turn the cursor Off }
Procedure CursorOn;                                        { Turn the Cursor On }

{$IFDEF NOVELL}

{$ENDIF}
implementation

Uses
  SysUtils,
  Toolhelp;

Procedure CursorOff;                                       { Turn the Cursor Off }
Var
  Cstate : Integer;                                        { Current cursor State }
Begin
  Cstate := ShowCursor(True);                              { Get State }
  While Cstate >= 0 do Cstate := ShowCursor(False);        { While ON turn Off }
End;

Procedure CursorOn;                                        { Turn Cursor On }
Var
  Cstate : Integer;                                        { Current cursor State }
Begin
  Cstate := ShowCursor(True);                              { Get current State }
  While Cstate < 0 do Cstate := ShowCursor(True);          { While off turn on }
End;

Procedure Delay(Ms : Integer);                             { Delay for Ms millisecs }
                                                           {If Ms is passed as 0, then calibrate }
Var
  L,MaxLoops,StartL,EndL,Down,Up,Res : LongInt;            { Local Vars }
  Ti  : TTimerInfo;
Begin
  Up := 0;
  Down := 100000;
  if Not DelayInit then begin
    Ti.dwSize := sizeof(LongInt) * 3;
    TimerCount(@Ti);
          StartL := Ti.dwmsSinceStart;                     { Get Start Time }
    if Not DelayInit then begin                            { Include the Test }
      for L := 0 to 100000 do begin                        { Loop through the following 100000 times }
        Dec(Down);                                         { Drop it }
        Res := Abs(Down - Up);                             { Diff }
        if Res = 0 then Inc(Res);                          { Bump }
        Inc(Up);                                           { Inc }
        end;
      end;
    TimerCount(@Ti);
    EndL := Ti.dwmsSinceStart;                                { Get Start Time }
                LoopsMs := 100000 Div (EndL - StartL);        { Calc MS Rate }
    DelayInit := True;                                        { We are done }
                end
        else begin
    if Ms = 0 then Exit;
                MaxLoops := LoopsMs * Ms;                              { Get Number of Loops }
                for L := 0 to MaxLoops do Begin                        { Loop through }
                        Dec(Down);                                           { Drop it }
                        Res := Abs(Down - Up);                               { Diff }
                        if Res = 0 then Inc(Res);                            { Bump }
                        Inc(Up);                                             { Inc }
      end
    end;
End;

end.

A High Resolution timer for Most Win95 Systems

{
   File Name: HRTimer.PAS V1.00
   Created: Apr 17 1997, 06:40 on the ThinkPAd by John Mertus
   Revision #6: Oct 12 1997, 10:56 on the Gateway by John Mertus

   This is a wrapper around the High Resolution Timer in
   Win95/WinNT

   Var
     HRT : THRTimer

   HRT := THRTimer.Create;
   HRT.StartTimer;  Resets the timer to zero
   HRT.ReadTimer;   Returns the elapsed time in milliseconds
                     since the time start

   HRT.Free;

   Edit history
        Version  1.00  Initial release
}

{------------------Unit HRTimer---------------------John Mertus April 97---}

                    Unit HRTimer;

{--------------------Interface-------------------------------}

                    interface


Uses Windows;

Type
   THRTimer = Class(TObject)
     Constructor Create;
     Function StartTimer : Boolean;
     Function ReadTimer : Double;

   private
     StartTime : Double;
     ClockRate : Double;

   public
     Exists    : Boolean;

   End;

{------------------------Implementation---------------------------------}

                    implementation

{------------------Create-------------------------John Mertus----Mar 97-}

     Constructor THRTimer.Create;

{ This reads the windows HR time and stores it for later use.             }
{                                                                         }
{*************************************************************************}
Var
  QW : TLargeInteger;

BEGIN
   Inherited Create;
   Exists := QueryPerformanceFrequency(QW);
   ClockRate := QW.QuadPart;
END;

{------------------StartTimer---------------------John Mertus----Mar 97-}

   Function THRTimer.StartTimer : Boolean;

{ This reads the windows HR time and stores it for later use.             }
{                                                                         }
{*************************************************************************}
Var
   QW : TLargeInteger;

BEGIN
   Result := QueryPerformanceCounter(QW);
   StartTime := QW.QuadPart;
END;

{-------------------ReadTimer---------------------John Mertus----Mar 97---}

   Function THRTimer.ReadTimer : Double;

{ This reads the windows HR time and stores it for later use.             }
{                                                                         }
{*************************************************************************}
Var
   ET : TLargeInteger;

BEGIN
   QueryPerformanceCounter(ET);
   Result := 1000.0*(ET.QuadPart - StartTime)/ClockRate;
END;

end.

How do I run a program?

From: Yeo Keng Hua <cinyeo@singnet.sg.com>

Check out FMXUTIL.PAS in Delphi examples:

function ExecuteFile(const FileName, Params, DefaultDir: string;
  ShowCmd: Integer): THandle;
var
  zFileName, zParams, zDir: array[0..79] of Char;

begin
  Result := ShellExecute(Application.MainForm.Handle, nil,
    StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),
    StrPCopy(zDir, DefaultDir), ShowCmd);
end;

Called with the code :

   executeFile('maker.exe','text_file','c:\maker', SW_SHOWNORMAL);

How to write text transparently on the canvas. using Textout

From: rkr@primenet.com

This is a bit of code that came on a CD-ROM with a "How To Book" I bought.. The file is called "HowUtils.Pas" Fades Text in, and or out on a Canvas.

function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: String): TRect;
var
  Pic: TBitmap;
  W, H: integer;
  PicRect, TarRect: TRect;
begin
  Pic := TBitmap.Create;
  Pic.Canvas.Font := Target.Font;
  W := Pic.Canvas.TextWidth(FText);
  H := Pic.Canvas.TextHeight(FText);
  Pic.Width := W;
  Pic.Height := H;
  PicRect := Rect(0, 0, W, H);
  TarRect := Rect(X, Y, X + W, Y + H);
  Pic.Canvas.CopyRect(PicRect, Target, TarRect);
  SetBkMode(Pic.Canvas.Handle, Transparent);
  Pic.Canvas.TextOut(0, 0, FText);
  FadeInto(Target, X, Y, Pic);
  Pic.Free;
  FadeInText := TarRect;
end;

procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig: TBitmap);
var
  Pic: TBitmap;
  PicRect: TRect;
begin
  Pic := TBitmap.Create;
  Pic.Width := TarRect.Right - TarRect.Left;
  Pic.Height := TarRect.Bottom - TarRect.Top;
  PicRect := Rect(0, 0, Pic.Width, Pic.Height);
  Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect);
  FadeInto(Target, TarRect.Left, TarRect.Top, Pic);
  Pic.Free;
end;

Different colors for the lines in the DBCtrlGrid

Does anybody know how to set different colors for the lines in the DBCtrlGrid?

use the drawColumnCell event. Also be sure to defautlDrawing false

procedure TMain.ProjectGridDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  projectGrid.canvas.brush.color := clWindow;
  projectGrid.canvas.fillRect(rect);
  if gdSelected  in state then
  begin
    projectGrid.canvas.brush.color := clHighlight;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clHighlightText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clHighlightText;
  end
  else if gdFocused in state then
  begin
    projectGrid.canvas.brush.color := clWindow;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clWindowText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clWindowText;
  end
  else if gdFixed in state then
  begin
    projectGrid.canvas.brush.color := clHighlight;
    if fsBold in projectGrid.canvas.font.style then
    begin
      projectGrid.canvas.font.color := clHighlightText;
      projectGrid.canvas.font.style := [fsBold];
    end
    else
      projectGrid.canvas.font.color := clHighlightText;
  end;
  with globalDataModule.qProjects do
  begin
  // test cirteria of record.  Set properties to override the default;
    if fieldByName('EST_COMPL_DATE').asDateTime < date then
      projectgrid.Canvas.font.color := clRed;
    if compareStr(fieldByName('STAT_CODE').asString, 'HD') = 0 then
      projectgrid.Canvas.font.color := clOlive;
    if  (compareStr(fieldByName('CHANGED').asString, 'Y') = 0) and
        (fieldByName('ASSIGN_EMP_ID').asInteger = userRecord.UserId) then
      projectgrid.Canvas.font.style := [fsBold];
  end;
  projectGrid.canvas.textOut(rect.left+2, rect.top+2, column.field.text);
end;

Overriding Virtual Methods

Anybody know what the difference is between OVERRIDING a virtual
method and REPLACING it? I'm confused on this point.

Say you have a class

  TMyObject = class (TObject)

  TOverrideObject = class (TMyObject)

procedure Wiggle; virtual;

procedure Wiggle; override;

Now, you create a TList containing a whole bunch of MyObjects and OverrideObjects in the TList.Items[n] property. The Items property is a pointer so to call your Wiggle method you have to cast Items. Now you could do this:

  if TObject(Items[1]) is TMyObject then
    TMyObject(Items[1]).Wiggle
  else if TObject(Items[1]) is TOverrideObject then
    TOverrideObject(Items[1]).Wiggle;

  TMyObject(Items[1]).Wiggle;

Now, say you left out the override directive in the declaration of the TOverrideObject.Wiggle method and then tried

  TMyObject(Items[1]).Wiggle;

So, overriding a method means declaring the method with the virtual (or dynamic) directive in a base class and then declaring it with the override directive in a sub class. Replacing a method means declaring it in the subclass without the override directive. Overriden methods of a subclass can be executed even when a specific instance of the subclass is cast as its base class. Replaced methods can only be executed if the specific instance is cast as the specific class.

How to do a delay without using 100% CPU time?

> I have to write a server-application (text-mode) in Delphi 3pro
> that waits for some input on the serial port. While waiting for input
> i need to make my app sleep to give other applications on the server
> the chance to use the cpu (so a simple repeat ... until won't work).

1. repeat ... until will not block other processes on your system because of the preemptive multitasking on win32, but you're right, your cpu-load will be 100%. only the current process is blocked, that means, for example, window redraws in the current application don't occur.

2. you will have to process arriving messages within your loop to solve the redraw problem, but cpu-load will remain at 100%. something like that will do:

   ---

   repeat
     while PeekMessage(Msg,0,0,0,pm_Remove) do begin
       TranslateMessage(Msg);
       DispatchMessage(Msg);
     end;
   until ThereIsSomethingGoingOnOnTheSerialLine;

   ---

3. you can also pause (e.g. Sleep(100)) for some time before polling for an event on the serial line. That reduces the cpu-load significantly.

4. i don't know how you get the information, if something's on the line, but if your component or whatever it is sends you a windows message if something happens, the best way is to write a message handler that executes the actions you need. but because you're in console mode, you'll need to write a window function and set it to the console window, e.g.:

   ---

   function MyWndProc(Wnd: HWnd; Msg,wParam,lParam:Integer): Integer;
   begin
     case Msg of
       wm_SerialLineReceivesData: begin
         ...
       end;
     else Result:=CallWindowProc(OldWndProc,Wnd,Msg,wParam,lParam);
     end;
   end;

   ---

   and in your main program

   ---

   var
     OldWndProc: Pointer;
   begin
    
   OldWndProc:=
     Pointer(SetWindowLong(GetActiveWindow,gwl_WndProc,
        Integer(@MyWndProc)));
     ...
     SetWindowLong(GetActiveWindow,gwl_WndProc,
        Integer(OldWndProc));
   end.

   ---

SHAREWARE NAG EXAMPLE !!

This here little piece of code GOT to be the quickest way to create a true shareware nag, that gives people the full functionality of the program, yet nags people big time untill they register (cruel, huh :) )

This shareware nag makes sure that the user can only execute your program ONCE every Windows session.

In your FormShow event:

procedure TForm1.FormShow(Sender : TObject);
var atom : integer;
    CRLF : string;
begin
    if
      GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then
         atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')  
    else
       begin
          CRLF := #10 + #13;
          ShowMessage('This version may only be run once for every Windows Session.' + CRLF +
                      'To run this program again, you need to restart Windows, or better yet:' + CRLF +
                      'REGISTER !!');
          Close;
       end;
end;

Auto Scaling routine...

This routine has made life very very easy. This routine will insure that your application will look scaled at ANY resolution. Notice the 640 reference. This is because I develop apps in 640x480. You can adjust the routine to work from what YOU develop in so you dont have to worry about the odd and big screen resolutions that your users may have. Place, in the OnCreate event of the form you want auto-scaled:

AdjustResolution(Self);

{ AdjustResolution ******************************************************* }
{ This procedure scales all the children on a given form to conform to the }
{ current screen resolution                                                }
{ ************************************************************************ }
procedure AdjustResolution(oForm:TForm);
var
iPercentage:integer;
begin
if Screen.Width > 640 then
  begin
    iPercentage:=Round(((Screen.Width-640)/640)*100)+100;
    oForm.ScaleBy(iPercentage,100);
  end;
end;