First/Last changed File in Folder

Problem/Question/Abstract:

Sometimes its nessessary to know which File of an Folder was changed at the last.

Answer:

Sometimes its nessessary to know which File of an Folder was changed at the last. I wrote this function below. It can give you the File with the oldesd content too, if you set the parameter first := True. For the comparing I've used the API - Function CompareFileTime. If you wants to know the oldes or youngest created file or the last/first accessed file see the comments in the function.

function GetLastOrFirstChangedFileOfFolder(First: Boolean; Folder: string): string;
var
  Ft1, Ft2: TFileTime;
  sr: TSearchrec;
  what, Res: Integer;
begin
  if not DirectoryExists(Folder) then
    exit;
  if Folder[Length(Folder)] <> '\' then
    Folder := Folder + '\';
  if First then
    What := 1
  else
    What := -1;
  res := FindFirst(Folder + '*.*', faAnyFile, sr);
  ft1 := sr.FindData.ftLastWriteTime;
  //ft1 := sr.FindData.ftCreationTime;   for the first/last created
  //ft1 := sr.FindData.ftLastAccessTime;  for the first/last access
  Result := sr.Name;
  while res = 0 do
  begin
    Ft2 := sr.FindData.ftLastWriteTime;
    //ft1 := sr.FindData.ftCreationTime;   for the first/last createt
    //ft1 := sr.FindData.ftLastAccessTime;  for the first/last access
    if CompareFileTime(ft1, ft2) = What then
    begin
      ft1 := Ft2;
      Result := sr.Name;
    end;
    res := FindNext(sr);
  end;
  FindClose(sr);
end;

How to convert extended characters into their HTML character entities

Problem/Question/Abstract:

I just need a routine that scans an ordinary string and the replaces all occurrences of '<', '&' and all other illegal characters by the correct HTML symbol.

Answer:

In Delphi 7 (HTTPApp.pas) you have:

function HTMLEncode(const AStr: string): string;
const
  Convert = ['&', '<', '>', '"'];
var
  Sp, Rp: PChar;
begin
  SetLength(Result, Length(AStr) * 10);
  Sp := PChar(AStr);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    case Sp^ of
      '&':
        begin
          FormatBuf(Rp^, 5, '&amp;', 5, []);
          Inc(Rp, 4);
        end;
      '<', '>':
        begin
          if Sp^ = '<' then
            FormatBuf(Rp^, 4, '&lt;', 4, [])
          else
            FormatBuf(Rp^, 4, '&gt;', 4, []);
          Inc(Rp, 3);
        end;
      '"':
        begin
          FormatBuf(Rp^, 6, '&quot;', 6, []);
          Inc(Rp, 5);
        end;
    else
      Rp^ := Sp^
    end;
    Inc(Rp);
    Inc(Sp);
  end;
  SetLength(Result, Rp - PChar(Result));
end;

which is pretty good. It will use quite a bit of memory on long input strings, though. For some reason it sets the result buffer to 10 times the length of the input buffer when 6 times would have been enough (for the worst case, all quote chars (").

I rolled my own before D7 was released (part of my WOS framework - found on the D7 Companion CD):

function HTMLEncode(const S: string): string;
const
  ConversionSet = ['&', '<', '>', '"', '+']; {The '+' is because of a IE bug}
  ConversionChars: PChar = '&<>"+';
  Entities: array[1..5] of string = ('&amp;', '&lt;', '&gt;', '&quot;', '&#43;');
var
  Sp, Rp: PChar;
  P: integer;
begin
  SetLength(Result, Length(S) * 6); {Ouch... ( worst case is all "'s )}
  Sp := PChar(S);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    if not (Sp^ in ConversionSet) then
    begin
      Rp^ := Sp^;
      Inc(Rp);
    end
    else
    begin
      P := StrScan(ConversionChars, Sp^) - ConversionChars + 1;
      StrCopy(RP, PChar(Entities[P]));
      Inc(Rp, Length(Entities[P]));
    end;
    Inc(Sp);
  end;
  SetLength(Result, Rp - PChar(Result));
end;

Send characters to another control (in any application)

Problem/Question/Abstract:

How can I e.g. "type" programmatically in another application?

Answer:

There are several methods to send keystrokes or characters to a WinControl. The SetKeyboardState requires the control to have the focus but can send more (esp. special) keys. The use of WM_CHAR message enables you to send characters even to a hidden control unless you have found out the handle of it (there are a couple of ways to find out a controls handle). Once you've got it, you can send messages to it.

I'm using this method for a little tool to "type" certain frequently used phrases while posting to newsgroups.

I hardcoded the handle of the edit control of my favorite newsreader and now I have a small and handy tool to type messages faster than ever.

procedure SendMsg(const h: HWND; const s: string);
var
  i: integer;
begin
  if h = 0 then
    Exit;
  if Length(s) = 0 then
    Exit;
  for i := 1 to Length(s) do
  begin
    if Ord(s[i]) in [9, 13, 32..254] then
      SendMessage(h, WM_CHAR, Ord(s[i]), 0);
  end;
end;

Including Components into a StatusBar

Problem/Question/Abstract:

The TStatusbar usually does not allow to place components on itself. But sometimes it would be very fine to add -for example- a TProgressBar on a Statusbar.

This Article shows how to add components to a TStatusbar and how to fit it into one of the Statusbar-Panels.

Answer:

There are (at least) two ways to add Components on your Statusbar:

1. Create an own Statusbar-Object

Create your own Statusbar and allow to add components on it. This is possible in overriding the Create-Constructor:

type
  TMyStatusBar = class(TStatusBar)
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

constructor TMyStatusBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls];
  //that&#8217;s all !!
end;

That&#8217;s all! Now this component accept other components as &#8220;Children&#8221; and you can put them at design-time onto the statusbar!

But I don&#8217;t like this way very much because you have to use this new component. I prefer to use the &#8220;old&#8221; components and manipulating them a little bit. So lets have a look to my favourite way:

2. &#8220;Adopt&#8221; the other component

The simplest way to include components to a statusbar is to adopt the component! Place the TStatusbar on your Form, also place the Progressbar (or other component you wish to include on your Statusbar) on the form (!). Then do this in the &#8220;OnShow&#8221; Event of the Form:

Progressbar1.Parent := statusbar1;
Progressbar1.top := 1;
Progressbar1.left := 1;

Now the Progressbar is &#8220;adopted&#8221; by the Statusbar.

But unfortunatley it doesn&#8217;t look very nice because the Progressbar is larger than the panel and the position is not correct. So we have to determine the exact position of the Progresbar by using the Statubar&#8217;s border, width and height. (We have to add this code to the &#8220;OnShow&#8221; Event of the form, because in the &#8220;OnCreate&#8221; event still no Handles are avalible.)

procedure TForm1.FormShow(Sender: TObject);
var
  r: TRect;
begin
  Statusbar1.perform(SB_GETRECT, 0, integer(@R));
  //determine the size of panel 1

//SB_GETRECT needs Unit commctrl
// 0 = first Panel of Statusbar; 1 = the second and so on.

  progressbar1.parent := Statusbar1; //adopt the Progressbar

  progressbar1.top := r.top; //set size of
  progressbar1.left := r.left; //Progressbar to
  progressbar1.width := r.right - r.left; //fit with panel
  progressbar1.height := r.bottom - r.top;

end;

Now the Progressbar fits exactly into the first panel of the statusbar! If you want to use the second or another panel, you only have to change the parameter of the &#8220;perform&#8221; command.

Great Looking Transparent Forms, Strange Shaped !

Problem/Question/Abstract:

Using This Code, You Can Make Some Unique Looking Forms, Transparent, Multi-shaped and more !!

Answer:

////////////////////////////////////////////////////////////////////////
/////// TRIED ON WINDOWS 2000 PROFESSIONAL AND SERVER WITH DELPHI 5
/////// PLEASE DO NOT TRY TO DEFINE ANY VALUES< MAY CAUSE ERROS
////////////////////////////////////////////////////////////////////////

Hi Everybody,

in a late time in the evening, i started digging in this code, and here is the result, to try it and see the results your self, please do the following......

1- Start A New Project In Delphi 5
2- Make Sure JPEG Is In Your Windows Clause
3- Add These Lines


const
  WS_EX_LAYERED = THE - SECRET - CODE - HERE - - -LOOK - COMMENT;

  LWA_COLORKEY = 1; //1
  LWA_ALPHA = 2; //2

type
  TSetLayeredWindowAttributes = function(
    hwnd: HWND; // handle to the layered window
    crKey: TColor; // specifies the color key
    bAlpha: byte; // value for the blend function
    dwFlags: DWORD // action
                ): BOOL; stdcall;


You Saw (THE-SECRET-CODE-HERE---LOOK-COMMENT) Above A Minute Ago, In This Place Add Any Of The Following Values

Const

$81111 Form Caption Flipped
$82222 Form Visible But Can Never Get Focused
$83333 Form Caption Flipped And Never Gets Focus
$80FFF Form is (bsToolWindow), Never Maximized, Never Gets Focused
$FFFFF Form is (bsToolWindow), Form Flipped, Never Gets Focus, Never Maximizes
$222222 Very Strange Behaviour On Form Move, Try It !!
$222000 Form Looks As In Win 3.11 Applications
$333333 Captionless Window, Never Moves
#333000 Form Like In Win 3.11 Applications, Caption Flipped
$444444 The Whole Form With Everything On It Is Flipped
$444888 The Whole Form With Everything On It Is Flipped, It Is Converted To (bsToolWindow)
$555555 Form And All Contents Are Flipped, But Caption Still In Place ( Not Flipped )
$555888 Form And All Contents Are Flipped, But Caption Still In Place ( Not Flipped ), It Is

Converted To (bsToolWindow)
$666666 Form And All Contents Are Flipped, Win 3.11 GUI
$666888 Form And All Contents Are Flipped, Win 3.11 GUI, (bsTooWindow)

$777000 This Is Strange, Looks Like A 16bit Application, Everything Flipped, Caption In Place ***BUT***, Windows Accesses Your Form As If It Was Not A Part Of Your Application, I Mean, When Minimizing Application, You Will See One Entry In The Taskbar, When Restoring It, Every Form Will Have Its Own Entry, Well, It Makes An MDI Like Application !!

$777888 The Same But The MDI Form Will Have No Icon At All.
$888888 (bsToolWindows) Transparent Form
$888000 Normal Transparent Form
$888FFF (bsToolWindows) Transparent Form, Cant Get Focused
$8F8F8F (bsToolWindows) Transparent Form, MDI Alike
$999999 Transparent (bsToolWindow) Form, Caption Flipped
$999000 Transparent Form, Caption Flipped
$999FFF Transparent (bsToolWindow) Form, Caption Flipped, Never Focused


4- In Your FormCreate Event, Place This Code

var
  Info: TOSVersionInfo;
  F: TSetLayeredWindowAttributes;
begin
  inherited;
  Info.dwOSVersionInfoSize := SizeOf(Info);
  GetVersionEx(Info);
  if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and
    (Info.dwMajorVersion >= 5) then
  begin
    F := GetProcAddress(GetModulehandle(user32),
      'SetLayeredWindowAttributes');
    if Assigned(F) then
    begin
      SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle,
        GWL_EXSTYLE) or WS_EX_LAYERED);
      F(Handle, 1, Round(255 * 75 / 100), LWA_ALPHA);
    end;
  end;
end;

How to store an RTF text in a database blob field without using a TDBRichEdit

Problem/Question/Abstract:

How to store an RTF text in a database blob field without using a TDBRichEdit

Answer:

{ ... }
var
  blobS: TBlobStream;
begin
  blobS := TBlobStream.Create(TBlobField(table1.FieldByName('YourField')), bmWrite);
  try
    table1.Edit;
    try
      RichEdit1.Lines.SaveToStream(blobS);
      table1.Post;
    except
      table1.Cancel;
      raise;
    end;
  finally
    blobS.Free;
  end;
end;

Reconnecting to network shares with the help of a Component.

Problem/Question/Abstract:

Ever lost a networked share and didn't know how to connect to it? Well with this component you can search the network for a specific share containing a file or a directory and automatically reconnect to it.

Answer:

NOTE: IF YOU ALLREADY KNOW THE LOCATION OF THE SHARE YOU SHOULDN'T USE THIS COMPONENT AS IN LARGE NETWORKS WILL BE SLOW. THIS IS ONLY IF YOU DON'T KNOW THE EXACT LOCATION BUT CAN LOCATE IT BY USING A MARKER SUCH AS A SPECIFIC FILE OR FOLDER.

TIP: Use the BeforeConnect Event to specify whether a connection should be made.

unit Reconnect;

interface

uses
  Windows, Messages, StdCtrls, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    FileCtrl;

type
  TSIsType = (itDir, itIniFile, itApp, itOther);
  TBeforeConnectEvent = procedure(Owner: TObject; AssignPath: string; var Accept:
    boolean) of object;
  TAfterConnectEvent = procedure(Owner: TObject; AssignedPath: string) of object;
  TOnFail = procedure(Owner: TObject; FailMessage: string) of object;
  TReconnect = class(TComponent)
  private
    { Private declarations }
    DidAssign: boolean;
    FItemToLookFor: string;
    FUserName: string;
    FPassword: string;
    FLetterToAssign: Char;
    FIsType: TSIsType;
    FOutputLabel: TLabel;
    FFailMessage: string;
    FBeforeConnect: TBeforeConnectEvent;
    FAfterConnect: TAfterConnectEvent;
    FOnFail: TOnFail;
    function DoEnum(NetResT: PNetResourceA): integer;
    function addbs(g: string): string; overload;
    function addbs(g: string; SLASH: CHAR): string; overload;
    function SearchFor(NetResT: NETRESOURCE; Path, param: string): boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    function SearchAndAssign: boolean;
    property ItemToLookFor: string read FItemToLookFor write FItemToLookFor;
    property LetterToAssign: Char read FLetterToAssign write FLetterToAssign;
    property IsType: TSIsType read FIsType write FIsType default itDir;
    property OutputLabel: TLabel read FOutputLabel write FOutputLabel;
    property UserName: string read FUserName write FUserName;
    property Password: string read FPassword write FPassword;
    property BeforeConnect: TBeforeConnectEvent read FBeforeConnect write
      FBeforeConnect;
    property AfterConnect: TAfterConnectEvent read FAfterConnect write FAfterConnect;
    property OnFail: TOnFail read FOnFail write FOnFail;
  end;

procedure Register;

implementation

function TReconnect.addbs(g: string; SLASH: CHAR): string;
begin
  g := trim(g);
  if g <> '' then
  begin
    if g[length(g)] <> SLASH then
      result := g + SLASH
    else
      result := g;
  end
  else
    result := g;
end;

function TReconnect.addbs(g: string): string;
begin
  result := addbs(g, '\');
end;

function TReconnect.SearchFor(NetResT: NETRESOURCE; Path, param: string): boolean;
var
  cont: boolean;
  Exists: boolean;
begin
  Exists := false;
  path := addbs(path);
  SearchFor := false;
  if IsType = itDir then
    Exists := directoryExists(path + param);
  if IsType = itIniFile then
    Exists := FileExists(path + param);
  if IsType = itApp then
    Exists := FileExists(path + param);
  if IsType = itOther then
    Exists := FileExists(path + param);
  if Exists then
  begin
    cont := true;
    try
      if assigned(FBeforeConnect) then
        BeforeConnect(self, path, cont);
    except
      showmessage('Failed to call BeforeConnect.');
    end;
    if cont then
    begin
      try
        NetResT.lpLocalName := pchar(string(FLetterToAssign) + ':');
        WNetAddConnection2A(NetResT, pchar(UserName), pchar(Password),
          CONNECT_UPDATE_PROFILE);
        DidAssign := true;
        try
          if assigned(FAfterConnect) then
            AfterConnect(self, path);
        except
          showmessage('Failed to call AfterConnect.');
        end;
      except on E: Exception do
          Showmessage(E.Message);
      end;
      SearchFor := true;
    end;
  end;
end;

function TReconnect.DoEnum(NetResT: PNetResourceA): integer;
var
  EnumH: THandle;
  cnt: cardinal;
  buffsize: cardinal;
  NetResBuf: array[0..200] of NETRESOURCE;
  res: word;
  i: integer;
begin
  if DidAssign then
    exit;
  try
    cnt := 255;
    WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, NetResT, EnumH);
    res := 0;
    while (res = NO_ERROR) do
    begin
      buffsize := sizeof(NetResBuf);
      res := WNetEnumResource(EnumH, cnt, @NetResBuf, buffsize);
      for i := 0 to cnt - 1 do
      begin
        if Assigned(OutputLabel) then
        begin
          OutputLabel.Caption := NetResBuf[i].lpRemoteName;
          OutputLabel.Refresh;
        end;
        if NetResBuf[i].dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
        begin
          if not DidAssign then
            if SearchFor(NetResBuf[i], string(NetResBuf[i].lpRemoteName),
              ItemToLookFor) then
            begin
              result := 0;
              exit;
            end;
        end;
        if (NetResBuf[i].dwScope = RESOURCEUSAGE_CONTAINER) then
          doEnum(@NetResBuf[i]);
      end;
    end;
    WNetCloseEnum(EnumH);
    result := 1;
  except on E: Exception do
    begin
      FFailMessage := E.Message;
      if Assigned(FOnFail) then
        OnFail(Owner, FFailMessage);
      result := 0;
    end;
  end;
end;

function TReconnect.SearchAndAssign: boolean;
begin
  DidAssign := false;
  DoEnum(nil);
  result := true;
end;

procedure Register;
begin
  RegisterComponents('VNPVcls', [TReconnect]);
end;

end.

Parse the lines of a text file and import them into a Paradox table

Problem/Question/Abstract:

I have a text file with a certain format where only the first line is of type year and month. The rest is always the same: Integer, String, String, Integer, Integer, Integer. Example:

2001,10
000368,"The Name","Category",000671000,0724690,009421
000701,"The Name","Category",000398500,0398500,005181

What's the best way to import this into Paradox tables?

Answer:

Solve 1:

I would read it one line at a time and parse it with something like the following parser. The variable ofs needs to be set to zero to start the parsing at the beginning of the line.

{ ... }
ReadLn(f, line);
ofs := 0;
if GetNextSepValueOK(line, ofs, YrStr, ', ', '"') and
        GetNextSepValueOK(line, ofs, MoStr, ', ', '"') then
  {prep date}
else
  raise Exception.Create('Cannot find year and month');
while not EOF(f) do
begin
  ReadLn(f, line);
  ofs := 0;
  {Do Append and try, etc. }
  while GetNextSepValueOK(line, ofs, value, ', ', '"') do
    {Do Post}
end;
end;
{ ... }

function GetNextSepValueOK(const line: string; var ofs: integer; out value: string;
  const Separator, Grouper: char): Boolean;
var
  i, oc, lnb, GrouperCount: integer;
  c: char;
  temp: ShortString;
begin
  oc := 0;
  lnb := 0;
  GrouperCount := 0;
  i := ofs;
  while (ofs < length(line)) do
  begin
    c := line[ofs + 1];
    if not Odd(GrouperCount) and (c = Separator) then
      break
    else if c = Grouper then
    begin
      inc(GrouperCount);
      if odd(GrouperCount) and (ofs > i) and (line[ofs] = Grouper) then
      begin
        inc(oc);
        temp[oc] := Grouper;
      end;
    end
    else if (c > ' ') or (lnb > 0) or odd(GrouperCount) then
    begin
      inc(oc);
      temp[oc] := c;
    end;
    if (c > ' ') or odd(GrouperCount) then
      lnb := oc;
    inc(ofs);
  end;
  if (ofs < length(line)) and (line[ofs + 1] = Separator) then
  begin
    inc(ofs);
    Result := true;
  end
  else
    Result := (i < length(line)) and not Odd(GrouperCount);
  if Result then
  begin
    temp[0] := char(lnb);
    value := temp;
  end;
end;


Solve 2:

procedure TForm1.ImportFile(const filename: string);
var
  F: Textfile;
  year, month: Integer;
  line: string;
  sl: Tstringlist;
begin
  Assignfile(F, filename);
  Reset(F);
  try
    ReadLn(F, line);
    sl := TStringlist.Create;
    try
      sl.QuoteChar := '"';
      sl.Commatext := line;
      year := StrToInt(sl[0]);
      month := StrToInt(sl[1]);
      while not EOF(F) do
      begin
        Readln(line);
        sl.Commatext := line;
        SaveRecord(sl);
      end;
    finally
      sl.free
    end;
  finally
    Closefile(f)
  end;
end;


The Saverecord method would be something like:

procedure Tform1.SaveRecord(sl: TStringlist);
begin
  if sl.Count <> 6 then
    raise Exception.Create('Invalid record');
  table1.Append;
  table1['ID'] := sl[0];
  table2['Name'] := sl[1];
  { ... }
  table1.Post;
end;


Solve 3:

You can use the CommaText property of a TStringList to parse the lines. Something like this:

procedure ReadFile(FileName: string);
var
  F: TextFile;
  S: string;
  List: TStringList;
  i: integer;
begin
  AssignFile(F, FileName);
  Reset(F);
  List := TStringList.Create;
  try
    Readln(F, S);
    List.CommaText := S;
    {do whatever you want with first line}
    while not EOF(F) do
    begin
      List.Clear;
      ReadLn(F, S);
      List.CommaText := S;
      {List now contains the integers and strings as separate strings}
      MyTable.Append;
      for i := 0 to 5 do
        MyTable.Fields[i].AsString := List.Strings[i];
      MyTable.Post;
    end;
  finally
    List.Free;
  end;
  closefile(f);
end;

Find files with FindFirst and FindNext

Problem/Question/Abstract:

Find files with FindFirst and FindNext

Answer:

The procedure FindFiles locates files (by a given "filemask") and adds their complete path to a stringlist. Note that recursion is used: FindFiles calls itself at the end of the procedure!

Before calling FindFiles, the stringlist has to be created; afterwards, you must free the stringlist.

In StartDir you pass the starting directory, including the disk drive. In FileMask you pass the name of the file to find, or a file mask. Examples:

FindFiles('c:\', 'letter01.doc')
FindFiles('d:\', 'euroen??.dpr')
FindFiles('d:\projects', '*.dpr')

If you want to test this procedure, start a new project and add some components to the form: two Edits (one for the starting directory, one for the mask), a Button, a TLabel and a ListBox.


implementation
....
var
  FilesList: TStringList;
  ...

  procedure FindFiles(StartDir, FileMask: string);
var
  SR: TSearchRec;
  DirList: TStringList;
  IsFound: Boolean;
  i: integer;
begin
  if StartDir[length(StartDir)] <> '\' then
    StartDir := StartDir + '\';

  { Build a list of the files in directory StartDir
     (not the directories!)                         }

  IsFound :=
    FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0;
  while IsFound do
  begin
    FilesList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Build a list of subdirectories
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir + '*.*', faAnyFile, SR) = 0;
  while IsFound do
  begin
    if ((SR.Attr and faDirectory) <> 0) and
      (SR.Name[1] <> '.') then
      DirList.Add(StartDir + SR.Name);
    IsFound := FindNext(SR) = 0;
  end;
  FindClose(SR);

  // Scan the list of subdirectories
  for i := 0 to DirList.Count - 1 do
    FindFiles(DirList[i], FileMask);

  DirList.Free;
end;

procedure TForm1.ButtonFindClick(Sender: TObject);
begin
  FilesList := TStringList.Create;
  FindFiles(EditStartDir.Text, EditFileMask.Text);
  ListBox1.Items.Assign(FilesList);
  LabelCount.Caption := 'Files found: ' + IntToStr(FilesList.Count);
  FilesList.Free;
end;

Image can show preview-image in dwg file (autocad file name)

Problem/Question/Abstract:

I have writen a component from image which can show the preview-image in dwg file

Answer:

unit DWGView;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  BITMAPINFO256 = record
    bmiHeader: BITMAPINFOHEADER;
    bmiColors: array[0..255] of RGBQUAD;
  end;

type
  TNoPreviewEvent = procedure(Sender: TOBject) of object;
  TFileErrorEvent = procedure(Sender: TOBject; DWGName: string) of object;

  TDWGView = class(TImage)
  private
    FDWGVersion: string;
    FDWGFile: string;
    FNoPreviewEvent: TNoPreviewEvent;
    FOnFileError: TFileErrorEvent;
    FImage: TImage;
    procedure SetDWGFile(const Value: string);
    procedure SetFImage(const Value: TImage);
    { Private declarations }
  protected
    procedure ReadDWG;
    constructor TDWGView;
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property Image: TImage read FImage write SetFImage;

    property DWGFile: string read FDWGFile write SetDWGFile;
    property DWGVersion: string read FDWGVersion;
    property OnNoPreview: TNoPreviewEvent read FNoPreviewEvent write FNoPreviewEvent;
    property OnFileError: TFileErrorEvent read FOnFileError write FOnFileError;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Voice', [TDWGView]);
end;

procedure TDWGView.ReadDWG;
var
  DWGF: TFileStream; // ?�???ġ?
  MemF: TMemoryStream; // ??&micro;????�?�
  BMPF: TMemoryStream; // ?&raquo;?�?ġ?
  SentinelF: TMemoryStream; //?�����&para;?  16�ֽ?

  bif: BITMAPINFO256; // ?&raquo;?�?ġ??�?�
  bfh: BITMAPFILEHEADER; // ?&raquo;?�?ġ??ġ??&middot; 14�ֽ?

  PosSentinel: LongInt; // ?�����&para;??&raquo;�?

  LenPreview: Integer; // �??�����&para;?�&reg;??�?&not;�?�???��&not;??&micro;?&micro;ij�&para;?
  RasterPreview: ShortInt; // ?&micro;?�?�???��&not;????&micro;�?&raquo;&not;�&micro;?�ֽ?�???
  // 0  �&raquo;&plusmn;�???�???��&not; 1  &plusmn;�??BMP?��&not;
    // 2  &plusmn;�??WMF?��&not;    3  ?&not;?&plusmn;&plusmn;�??BMP??WMF?��&not;
  PosBMP: Integer; // ?��&not;&micro;�տ?&micro;?&raquo;�?�&not;�&raquo;?&raquo;&para;&laquo;???&raquo;?�
  LenBMP: Integer; // ?��&not;��&para;?�&not;�&raquo;?&not;BITMAPFILEHEADER??&micro;?�&not;�&raquo;?&raquo;&para;&laquo;???&raquo;?�
  IndexPreview: Integer;
  TypePreview: Shortint; // ?��&not;????
begin
  if Assigned(FOnFileError) then
    FOnFileError(Self, FDWGFile);
  DWGF := TFileStream.Create(FDWGFile, fmOpenRead);
  BMPF := TMemoryStream.Create;
  MemF := TMemoryStream.Create;
  SentinelF := TMemoryStream.Create;
  try
    SetLength(FDWGVersion, 6);
    DWGF.ReadBuffer(FDWGVersion[1], 6);
    DWGF.Position := 13; // ?ġ?�??�13�&brvbar;�&not;???�����&para;?
    DWGF.Read(PosSentinel, 4);
    DWGF.Position := PosSentinel;
    SentinelF.CopyFrom(DWGF, 16); // &para;????�����&para;?
    DWGF.Read(LenPreview, 4); // &para;???
    DWGF.Read(RasterPreview, 1); // &para;????��&not;????
    for IndexPreview := RasterPreview - 1 downto 0 do
    begin
      MemF.Position := 0;
      MemF.CopyFrom(DWGF, 9); // ?��&not;???�?� 9�ֽ?
      MemF.Position := 0;
      MemF.Read(TypePreview, 1); // TypePreview ?��&not;????
      case TypePreview of
        1: ; // ?�??&micro;�???��???
        2:
          begin
            // BMP?��&not;,??DWG?ġ?�?&plusmn;���&micro;�BMP?��&not;?�????????�?BMP&plusmn;�&middot;&para;&micro;�
            // ?�?�?ġ???&micro;?�&not;&micro;&laquo;??�&raquo;&plusmn;���BITMAPFILEHEADER??&micro;?
            MemF.Position := 1;
            MemF.Read(PosBMP, 4); // 2,5
            MemF.Read(LenBMP, 4); // 6,9
            DWGF.Position := PosBMP;
            DWGF.ReadBuffer(bif, sizeof(bif));

            with bif do
            begin
              bmiColors[0].rgbBlue := 0;
              bmiColors[0].rgbGreen := 0;
              bmiColors[0].rgbRed := 0;

              bmiColors[225].rgbBlue := 255;
              bmiColors[225].rgbGreen := 255;
              bmiColors[225].rgbRed := 255;
            end;

            bfh.bfType := $4D42;
            bfh.bfSize := LenBMP + sizeof(bfh); //
            bfh.bfReserved1 := 0;
            bfh.bfReserved2 := 0;
            bfh.bfOffBits := 14 + $28 + 1024;

            BMPF.Position := 0;
            BMPF.Write(bfh, sizeof(bfh));
            BMPF.WriteBuffer(bif, sizeof(bif));
            BMPF.CopyFrom(DWGF, LenBMP - 1064);
            BMPF.Position := 0;
            Picture.Bitmap.LoadFromStream(BMPF);
          end;
        3: ; // WMF?ġ?�&not;?��?22�ֽ?��&micro;�Aldus?ġ??&middot;
      end;

    end;
  finally
    SentinelF.Free;
    MemF.Free;
    DWGF.Free;
    BMPF.Free;
  end;

end;

procedure TDWGView.SetDWGFile(const Value: string);
begin
  FDWGFile := Value;
  ReadDWG;
end;

procedure TDWGView.SetFImage(const Value: TImage);
begin
  FImage := Value;
end;

constructor TDWGView.TDWGView;
begin
  //TODO: Add your source code here
  FDWGFile := '';
  FDWGVersion := '';
end;

end.

Creating a descendant of a component to enhance functionality

Problem/Question/Abstract:

Adding an accelerator key to a TPageControl

Answer:

This tip is an example of extending the functionality of a component by creating a descendant. While implicit to the discussion at hand, here's where the power of an object-oriented language such as Delphi lays. As you'll see in the code below, it doesn't take much to create new functionality of an object by creating a descendant. The point of this is that had I not been using an object-oriented language, I would have had to re-write the original code of the TPageControl, then add the extended functionality. Fortunately, the VCL, which is really an object hierarchy, allows me to transparently inherit and retain the ancestral functionality and concentrate on the new functionality. You gotta love it!

For those of you new to Delphi, an accelerator key is a key that is pressed in combination with the Alt key to execute a command. They're sometimes called keyboard shortcuts or hotkeys, and you'll typically see them in menus as the underlined letter of a menu item. For instance, the "F" in the File menu selection is an accelerator key for that item. So to open up the File menu, you'd press Alt-F.

Accelerator keys aren't limited to just menu items. In fact, for almost any Caption property or a Caption-like property (e.g. Radio Group items) of a component, you can define an accelerator key. All you need to do is place an "&AMP" before a letter to designate it as an accelerator key. This is useful with VCL components like a TRadioGroup's Items, which allow the user to quickly select the radio button choice with the touch of a key. However, not all VCL components will respond to accelerator keystrokes if you define them. TPageControl in Delphi 2.0, which replaces TTabbedNotebook, is one of those components. And with it, accelerator key functionality would be particularly useful.

The only method I know for implementing accelerator key functionality in a TPageControl is to create a new component. There's another way, but you have to create menu and define hotkeys for menu items with equivalent functionality (they'll turn your pages for you), and that's a pretty kludgy way of doing things. Besides, the code to accomplish what we want is actually very simple.

Below is the unit code for a descendant of TPageControl that adds accelerator key functionality. We'll discuss the particulars after the listing:

unit accel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls;

type
  TAccelPageCtrl = class(TPageControl)
  private
    { Private declarations }
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure TAccelPageCtrl.CMDialogChar(var Msg: TCMDialogChar);
var
  I: Integer;
  Okay: Boolean;
begin

  Okay := False;

  inherited; //call the inherited message handler.

  //Now with our own component, start at Page 1 (Item 0) and work to the end.
  for I := 0 to PageCount - 1 do
  begin
    //Is key pressed accelerator key in Caption?
    Okay := IsAccel(Msg.CharCode, Pages[I].Caption) and CanChange(I);
                //this is the fix
    //It is, so change the page and break out of the loop.
    if Okay then
    begin
      Msg.Result := 1; //you can set this to anything, but by convention it's 1
      ActivePage := Pages[I];
      Change;
      Break;
    end;
  end;

end;

procedure Register;
begin
  RegisterComponents('BD', [TAccelPageCtrl]);
end;

end.

As you can see from the above. all that's required to add accelerator key response is a simple message handler procedure. The message we're interested in is CM_DialogChar, a Delphi custom message type encapsulated by TCMDialogChar, which is a wrapper type for the Windows WM_SYSCHAR message. WM_SYSCHAR is the Windows message that is used to trap accelerator keys; you can find a good discussion of it in the online help. The most important thing to note is what happens when the TAccelPageCtrl component detects that a CM_DialogChar message has fired.

Take a look at the CMDialogChar procedure, and note that all that's going in the code is a simple for loop that starts at the first page of the descendant object and goes to the last page, unless the key that was pressed happened to be an accelerator key. We can easily determine if a key is an accelerator key with the IsAccel function, which takes the key code pressed and a string (we passed the Caption property of the current TabSheet). IsAccel searches through the string and looks for a matching accelerator key. If it finds one, it returns True. If so, we set the message result value and change the page of TAccelPageCtrl to the page where the accelerator was found by setting the ActivePage property and calling the inherited Change procedure from TPageControl.

I haven't used TPageControl since I created this component because of how easy TAccelPageCtrl makes switching from TabSheet to TabSheet. It's far easier to do a Alt-<key> combination than use the mouse when you're at the keyboard. Play around with this and you'll be convinced not to use the standard VCL TPageControl.

How to prevent the cursor from jumping to the start of a TDBMemo after setting the charcase property

Problem/Question/Abstract:

I published the Charcase property of a TDBMemo, but have had a couple of problems. If I set the case to Upper or Lower sometimes, depending on what text is in the memo, no matter where I place the cursor and start typing (dataset in browse mode before this) the cursor jumps to the start of the memo and types there instead. Setting Charcase to normal corrects this. This only happens on a memo that is fairly full with text (the display area that is!). Any ideas why this is happening and how to stop it?

Answer:

This happens even in a normal TDBMemo. My solution is to use the OnEnter event of the TDBMemo:

{ ... }
x := TDBMemo(Sender).SelStart;
if not (TDBMemo(Sender).DataSource.DataSet.State in dsEditModes) then
  TDBMemo(Sender).DataSource.DataSet.Edit;
TDBMemo(Sender).SelStart := x;
TDBMemo(Sender).SelLength := 0;
{ ... }

This seems to solve that problem entirely. First it stores the clicked on location of the memo, and you can see what the rest does.

How to create a random list of numbers

Problem/Question/Abstract:

I should give an example of what I'm trying to do. The NewTrackList procedure is supposed to create a list of 14 numbers from 1 to 14, with no numbers repeated. The list is supposed to be random, that is, a different sequence of numbers is created every time the procedure runs.

Answer:

procedure NewTrackList;
var
  TrackNumbersList: array[1..14] of Integer;
  I, II: Integer;
  SameTracks: Boolean;
  S: string;
begin
  for I := 1 to 14 do
    TrackNumbersList[I] := 0;
  for I := 1 to 14 do
  begin
    TrackNumbersList[I] := Random(14) + 1;
    repeat
      SameTracks := False;
      for II := 1 to I - 1 do
      begin
        if I = 1 then
          Break;
        if TrackNumbersList[I] = TrackNumbersList[II] then
        begin
          SameTracks := True;
          TrackNumbersList[I] := Random(14) + 1;
          Break;
        end;
      end;
    until
      not SameTracks;
  end;
  S := '';
  for I := 1 to 14 do
    S := S + '  ' + IntToStr(TrackNumbersList[I]);
  Form1.Label1.Caption := S;
end;

procedure TTunesMain.FormCreate(Sender: TObject);
begin
  Randomize;
  NewTrackList;
end;

S is a local variable of type String. I obviously added a TLabel to the form, as well.

Master passwords for password protected Paradox tables

Problem/Question/Abstract:

Master passwords for password protected Paradox tables

Answer:

The password protection for Paradox tables is really weak. Here are two of the master passwords which you can use to open any protected Paradox table:


For Paradox 5 and 7 / BDE 3.0:

jIGGAe

cupcdvum


For Paradox 4 DOS:

nx66ppx