Miscellaneous

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.

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?
[Cory Lanou, CORYLAN@admin.cdw.com]

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.
[Brian Murray, murray@uansv3.vanderbilt.edu]

Say you have a class 

  TMyObject = class (TObject)
and a subclass 
  TOverrideObject = class (TMyObject)
Further, TMyObject has a Wiggle method: 
procedure Wiggle; virtual;
and TOverrideObject overrides Wiggle 
procedure Wiggle; override;
and you've written the implementations for both.

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;
but the power of polymorphism (and the override directive) allows you to do this: 
  TMyObject(Items[1]).Wiggle;
your application will look at the specific object instance pointed to by Items[1] and say "yes this is a TMyObject, but, more specifically, it is a TOverrideObject; and since the Wiggle method is a virtual method and since TOverrideObject has an overridden Wiggle method I'm going to execute the TOverrideObject.Wiggle method NOT the TMyObject.Wiggle method."

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

  TMyObject(Items[1]).Wiggle;
The application would look and see that even though Items[1] is really a TOverrideObject, it has no overridden version of the Wiggle method so the application will execute TMyObject.Wiggle NOT TOverrideObject.Wiggle (which may or may not be what you want).

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? [NEW]

From: "G÷ran Strehl" <gstrehl@metronet.de>

> 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.
Please email me and tell me if you liked this page.

This page has been created with HomeSite 2.5b