Miscellaneous
  1. Compile Date
  2. How do I run a program?
  3. How to write text transparently on the canvas. using Textout
  4. Different colors for the lines in the DBCtrlGrid
  5. Overriding Virtual Methods
  6. SHAREWARE NAG EXAMPLE !!
  7. Auto Scaling routine...
  8. From Dot to Comma[NEW]

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!

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.

SHAREWARE NAG EXAMPLE !!

From: Karsten Heitmann <heite@post1.tele.dk>

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;

The advantages here are that you leave all the functionallity at the users disposal, but the moment he closes the program, its bootie-time, folks ! All you got to do is write some obscure text and save it in the Windows global atom table.

Auto Scaling routine...

From: tekhed@charm.net.spam (Randy)

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;


Please email me and tell me if you liked this page.