Adding password security to your app with paradox

Problem/Question/Abstract:

Adding password security to your app with paradox

Answer:

I'm using a method to implement password security to your app using paradox.

First you make a table having a username field, name, password etc.. and you add Rights fiels type alpha(100) and a Level field of the same type.
Then in the app you got to use an actionlist to center all the commands your users will have access to.
The key here is to manage which action the user has right to use base in the rights field and (optionally) what level of access tha user has for the given action.

I use the tag property of each action in the actionlist to put the value of an accii char.
So, the first action will have a tag value o 65 the next 66,and so on.

Whe the app starts and acepts a user, it must check the chars of the Rights field againts each action's tag, if there's a macht that action is enabled.
So if a user has 'ABCZDH' in his/her rights field then will only have access to those actions marked by the asccii value in their tags.

Off course all of this comes with a nice screen where an 'administrador' can activate/deactivate the users's rights.

Get special Windows folder location (2)

Problem/Question/Abstract:

How to get special Windows folder location

Answer:

The two key functions to browse through those virtual Windows folders are

SHGetSpecialFolderLocation();

and

SHGetPathFromIDList()

They can be used as shown in the sample code. You may replace the CSIDL_PROGRAMS constant with another one from the list in the comment below.

uses ShlObj, ActiveX;

procedure TForm1.Button1Click(Sender: TObject);
var
  BI: TBrowseInfo;
  Buf: PChar;
  Dir,
    Root: PItemIDList;
  Alloc: IMalloc;
begin
  SHGetMalloc(Alloc);
  Buf := Alloc.Alloc(Max_Path);

  // CSIDL_BITBUCKET  RecycleBin
  // CSIDL_CONTROLS   ControlPanel
  // CSIDL_DESKTOP    Desktop
  // CSIDL_DRIVES     My Computer
  // CSIDL_FONTS      Fonts
  // CSIDL_NETHOOD    Network Neighborhood
  // CSIDL_NETWORK    The virtual version of the above
  // CSIDL_PERSONAL   'Personal'
  // CSIDL_PRINTERS   printers
  // CSIDL_PROGRAMS   Programs in the Start Menu
  // CSIDL_RECENT     Recent Documents
  // CSIDL_SENDTO     Folder SendTo
  // CSIDL_STARTMENU  The whole Start menu
  // CSIDL_STARTUP    The Autostart Group
  // CSIDL_TEMPLATES  Document templates

  // use of the constants above
  SHGetSpecialFolderLocation(Handle, CSIDL_PROGRAMS, Root);

  with BI do
  begin
    hwndOwner := Form1.Handle;
    // NIL means show all
    pidlRoot := Root;
    pszDisplayName := Buf;
    lpszTitle := 'Choose Folder';
    ulFlags := 0;
    lpfn := nil;
  end;

  try
    Dir := SHBrowseForFolder(BI);
    if Dir <> nil then
    begin
      SHGetPathFromIDList(Dir, Buf);
      ShowMessage(Buf);
      Alloc.Free(Dir);
    end;
  finally
    Alloc.Free(Root);
    Alloc.Free(Buf);
  end;
end;

How to programmatically change the size of the TOpenDialog window

Problem/Question/Abstract:

Is there a way to programmatically change the size of the TOpenDialog window so that more files will be shown? In Win98, the user can drag the dialog window to increase its size. Can the window size be increased under program control?

Answer:

The OnShow event seems to be a bit too early to do it. It has to be delayed a bit. Like this:

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure OpenDialog1Show(Sender: TObject);
  private
    { Private declarations }
    procedure MoveDialog(var Msg: TMessage); message WM_USER;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Caption := OpenDialog1.FileName;
end;

procedure TForm1.OpenDialog1Show(Sender: TObject);
begin
  PostMessage(Self.Handle, WM_USER, 0, 0);
end;

function GetDesktopWorkArea: TRect;
begin
  if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then
    Result := Rect(0, 0, Screen.Width, Screen.Height);
end;

procedure TForm1.MoveDialog(var Msg: TMessage);
var
  rec: TRect;
  wh: HWND;
  l, t, r, b: Integer;
begin
  wh := Windows.GetParent(OpenDialog1.Handle);
  {if GetWindowRect(wh, rec) then}
  if IsWindow(wh) then
  begin
    rec := GetDesktopWorkArea;
    l := rec.Left;
    t := rec.Top;
    r := rec.Right;
    b := rec.Bottom;
    MoveWindow(wh, l, t, r, b, True);
  end;
end;

Reorder a TPageControl at runtime

Problem/Question/Abstract:

Let's say we have a TPageControl with 15 pages, the design time PageIndex of each page is 0 to 14 respectively. Now we want to change this order at runtime. The new order is saved in an *.ini file, the values for the new order is stored in an array of integer we will call MyOrder. Here is what the code would look like to change the order:

var
  i: Integer;

  for i := 0 to PageControl1.PageCount - 1 do
    PageControl1.Pages[i].PageIndex = MyOrder[i];

After executing this block of code the order of the pages is unchanged. Can you tell my why this doesn't work?

Answer:

Solve 1:

Try this chunk of code. The key is that you set the 0th page index, then the 1rst, then the 2nd and so on. Since you're doing them in order, they don't get screwed up by later assignments.

procedure TForm1.ReorderBtnClick(Sender: TObject);
const
  NewOrder: array[0..6] of Integer = (2, 0, 6, 1, 5, 3, 4);
var
  X: Integer;
  OrigPages: array of TTabSheet;
begin
  {Keep an ordered list of tab sheets}
  SetLength(OrigPages, 7);
  for X := 0 to 6 do
    OrigPages[X] := PageControl.Pages[X];
  {Reorder tab sheets}
  for X := 0 to 6 do
    OrigPages[NewOrder[X]].PageIndex := X;
  {Release ordered list of tab sheets}
  OrigPages := nil;
end;


Solve 2:

This won't make order of the pages unchanged, but it won't give you the order you expect either. Remember that while you are re-ordering the pagecontrol, the pagecontrol also reorders itself. For example, you have a pagecontrol with 5 tabs, labelled One, Two, Three, Four and Five. If you try to reorder so that these pages move to the positions 3, 5, 1, 4, 2 respectively, then the order your code will put them in will be Four, Three, Two, One, Five because of the way they get reordered by the pagecontrol while you are moving them around.

Now, the really cool thing, and what seems to be happening to you, is that if you apply the exact same reordering (using your algorithm) as first used, the tabs will go back to the positions that they started from! Step through your code, and I'm sure your reordering routine will be called twice. To reorder them successfully, you would simply use a search and position algorithm, working from the last tab position back to the first to get around the pagecontrol's own re-ordering. I'm not sure from your post whether your array of positions is "for this position, this is the page that goes here" or "for this page, this is the position it should be in", so here is how to re-order your pagecontrol. We'll use the Tag property to let the page remember where it should be. Use only *one* of the first two commented for-loops, depending on your data structure.

{ ... }
var
  i, j: Integer;
begin
  {Use this loop if the following describes your array:
  "For this position (index), this is the page that goes here (contents)"
  (that is, the contents of the array is the current pageindex, and the array
  index is the new pageindex for that page)}

  for i := 0 to PageControl1.PageCount - 1 do
    PageControl1.Pages[MyOrder[i]].Tag := i;

  {OR use this loop if the following describes your array:
  "For this page (index), this is the position it should be in (contents)"
  (That is, the array index corresponds to the current pageindex, and the contents
  of the array is the new pageindex that page should have)}

  for i := 0 to PageControl1.PageCount - 1 do
    PageControl1.Pages[i].Tag := MyOrder[i];

  {Then simply reorder the pagecontrol}
  for i := PageControl1.PageCount - 1 downto 0 do
    for j := 0 to i do
      if PageControl1.Pages[j].Tag = i then
      begin
        PageControl1.Pages[j].PageIndex := i;
        Break;
      end;
end;

One of the two will work for you.


Solve 3:

The correct method to disconnect tabsheets and reconnect them:

{ ... }
var
  I: Integer;
  L: TList;
begin
  L := TList.Create;
  try
    {This just disconnects - you should replace this with your code to disconnect
                them in the order you want to reconnect them}
    for I := PageControl1.PageCount - 1 downto 0 do
    begin
      L.Add(PageControl1.Pages[I]);
      PageControl1.Pages[I].PageControl := nil;
    end;
    {Reconnect...}
    for I := 0 to L.Count - 1 do
      TTabSheet(L[I]).PageControl := PageControl1;
  finally
    L.Free;
  end;
end;

Create a sizeable form with a 3D look

Problem/Question/Abstract:

How to create a sizeable form with a 3D look

Answer:

Try these handlers for the WMNCPaint and WMNCHitTest messages. The form should have the Sizeable border style as the code uses the sizeable border area for drawing the 3D effect, whether or not you want the user to be able to resize. To prohibit resizing, include the WMNCHitTest handler, to allow it, leave it out.

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
  DC: HDC;
  Frame_H: Integer;
  Frame_W: Integer;
  Menu_H: Integer;
  Caption_H: Integer;
  Frame: TRect;
  Extra: Integer;
  Canvas: TCanvas;
begin
  { Predetermine some window parameters }
  Frame_W := GetSystemMetrics(SM_CXFRAME);
  Frame_H := GetSystemMetrics(SM_CYFRAME);
  if (Menu <> nil) then
    Menu_H := GetSystemMetrics(SM_CYMENU)
  else
    Menu_H := -1;
  Caption_H := GetSystemMetrics(SM_CYCAPTION);
  GetWindowRect(Handle, Frame);
  Frame.Right := Frame.Right - Frame.Left - 1;
  Frame.Left := 0;
  Frame.Bottom := Frame.Bottom - Frame.Top - 1;
  Frame.Top := 0;
  { Let standard frame draw }
  inherited;
  { Repaint frame area in 3-D style }
  DC := GetWindowDC(Handle);
  Canvas := TCanvas.Create;
  try
    with Canvas do
    begin
      Handle := DC;
      { Left and Top edges }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Left, Frame.Top),
        Point(Frame.Right, Frame.Top)]);
      { Right and Bottom edges }
      Pen.Color := clWindowFrame;
      PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Right, Frame.Bottom),
        Point(Frame.Right, Frame.Top - 1)]);
      { Left and Top edge, 1 pixel in }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1), Point(Frame.Left + 1,
        Frame.Top + 1),
        Point(Frame.Right - 1, Frame.Top + 1)]);
      { Right and Bottom edge, 1 pixel in }
      Pen.Color := clBtnFace;
      PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1), Point(Frame.Right - 1,
        Frame.Bottom - 1),
        Point(Frame.Right - 1, Frame.Top)]);
      { Remainder of Sizing border }
      for Extra := 2 to (GetSystemMetrics(SM_CXFRAME) - 1) do
      begin
        Brush.Color := clBtnFace;
        FrameRect(Rect(Extra, Extra, Frame.Right - Extra + 1, Frame.Bottom - Extra +
          1));
      end;
      { Left and Top Edge of Caption Area }
      Pen.Color := clBtnShadow;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1), Point(Frame_W -
        1,
          Frame_H - 1), Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
      { Right and Bottom Edge of Caption Area }
      Pen.Color := clBtnHighlight;
      PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
        Point(Frame.Right - Frame_W + 1, Frame_H + Caption_H + Menu_H - 1),
          Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
    end;
  finally
    Canvas.Free;
    ReleaseDC(Handle, DC);
  end;
end;

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
  HitCode: LongInt;
begin
  inherited;
  HitCode := Msg.Result;
  if ((HitCode = HTLEFT) or (HitCode = HTRIGHT) or (HitCode = HTTOP) or (HitCode =
    HTBOTTOM)
    or (HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or (HitCode = HTTOPRIGHT) or
    (HitCode = HTBOTTOMRIGHT)) then
  begin
    HitCode := HTNOWHERE;
  end;
  Msg.Result := HitCode;
end;

Conditional defines for all compiler versions

Problem/Question/Abstract:

Conditional defines for all compiler versions

Answer:

The following standard conditional symbols tell you which compiler is used:

VER80
Delphi 1.x

VER90
Delphi 2.x

VER93
C++ Builder 1.0

VER100
Delphi 3.x

VER120
Delphi 4.x

VER130
Delphi 5.x

VER140
Delphi 6.x

How to copy selected items from a TListBox to the clipboard without using the VCL Clipbrd unit

Problem/Question/Abstract:

I want to copy selected items (only text) from a TListBox that has LBS_EXTENDEDSEL style to the standard clipboard using only API functions.

Answer:

This code is untested and requires the unit APIClipboard from Tip "Clipboard access routines which use only API functions".

procedure CopySelectedListboxItemsToClipboard(listboxwnd: HWND);

  function GetItem(num: Integer): string;
  begin
    SetLength(Result, SendMessage(listboxwnd, LB_GETTEXTLEN, num, 0));
    if Length(Result) > 0 then
      SendMessage(listboxwnd, LB_GETTEXT, num, LPARAM(@Result[1]));
  end;

var
  num: Integer;
  selIndices: array of Integer;
  sl: TStringlist;
  S: string;
begin
  num = SendMessage(listboxwnd, LB_GETSELCOUNT, 0, 0);
  if num = LB_ERR then
  begin
    {listbox is a single selection listbox}
    num := SendMessage(listboxwnd, LB_GETCURSEL, 0, 0);
    if num = LB_ERR then
      Exit; {no selected item}
    S := GetItem(num);
  end
  else
  begin
    SetLength(selIndices, num);
    SendMessage(listboxwnd, LB_GETSELITEMS, num, LPARAM(@selIndices[0]));
    sl := TStringlist.Create;
    try
      for num := 0 to High(selIndices) do
        sl.Add(GetItem(selIndices[num]));
      S := sl.Text;
    finally
      sl.free;
    end;
  end;
  StringToClipboard(S);
end;

How to automatically drop down the lookup list in a TDBGrid

Problem/Question/Abstract:

I'm trying to do this: On enter in a cell of a DBGrid that is of fkLookup FieldKind type show the lookup list immediately without clicking on the little button that appears when I click in the cell.

Answer:

Solve 1:

Here is a sample how to drop down the lookup list automatically when the user enters a column and the OnColEnter event is fired.

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
const
  MyFieldName: string = 'SomeFieldName';
var
  I: Integer;
  MyGrid: TCustomDBGrid;
begin
  MyGrid := Sender as TCustomDBGrid;
  if MyGrid.SelectedField.FullName = MyFieldName then
  begin
    { Put the grid in edit mode. }
    MyGrid.EditorMode := True;
    { TCustomGrid.InplaceEditor is declared as protected property and
                cannot be addressed directly.
                 Since the inplace editor window is a child window of the grid,
                we can find it. }
    for I := 0 to MyGrid.ControlCount - 1 do
    begin
      if MyGrid.Controls[I] is TInplaceEdit then
        { Simulate an Alt+DownArrow key stroke }
        PostMessage(TWinControl(MyGrid.Controls[I]).Handle, WM_KEYDOWN,
          VK_DOWN, $20000000);
      Break;
    end;
  end;
end;


Solve 2:

In the OnColEnter event, send an Alt-DownArrow keystroke:

{ ... }
if DBGrid1.SelectedField.FieldName = 'fieldname' then
begin
  DBGrid1.EditorMode := True;
  keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0);
  keybd_event(VK_DOWN, MapVirtualKey(VK_DOWN, 0), 0, 0);
  keybd_event(VK_DOWN, 0, KEYEVENTF_KEYUP, 0);
  keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
end;

Or use a cracker class to expose TCustomGrid.InplaceEditor:

type
  TCrackGrid = class(TDBGrid);
  { ... }

procedure TForm1.DBGrid1ColEnter(Sender: TObject);
begin
  with TCrackGrid(DBGrid1) do
    if SelectedField.FieldName = 'fieldname' then
    begin
      EditorMode := True;
      {send Alt-DownArrow keystroke}
      PostMessage(InplaceEditor.Handle, WM_KEYDOWN, VK_DOWN, $20000000)
    end;
end;

How to download a file from the web to a local drive

Problem/Question/Abstract:

I want to write an application that can download upgraded versions of itself.

Answer:

Solve 1:

If you are just going to download there is no need to use ActiveX controls. Windows has the function you need already declared in the UrlMon.dll. To download a file to a local disk just use this code. Note: This function is not described in Delphi Help nor in the Win32 Programmer's Reference.

uses
  URLMon;

{ ... }
if URLDownloadToFile(nil, 'http://go.to/masdp', 'c:\index.html', 0, nil) <> 0 then
  MessageBox(Handle, 'An error ocurred while downloading the file.', PChar(Application.Title), MB_ICONERROR or MB_OK);
{ ... }


Solve 2:

Downloading a file is not very difficult, something like:


uses
  Wininet;

var
  InternetBrowserUserAgent: string;
  {Set it as you like. Win98/IE uses 'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)' }

{ ... }

function GetInternetStream(URL: string; Stream: TStream): LongInt;
type
  TNetBuffer = array[0..1023] of Byte;
  PNetBuffer = ^TNetBuffer;
var
  ihConnect, iDocument: HINTERNET;
  NetBuffer: PNetBuffer;
  BufferSize: Integer;
  I: integer;
begin
  Result := -1;
  ihConnect := InternetOpen(PChar(InternetBrowserUserAgent), LOCAL_INTERNET_ACCESS, '', '', 0);
  try
    if ihConnect <> nil then
    begin
      iDocument := InternetOpenURL(ihConnect, PChar(URL), nil, Cardinal(-1),
        INTERNET_FLAG_RELOAD or INTERNET_FLAG_DONT_CACHE or
        INTERNET_FLAG_RAW_DATA, 0);
      try
        if iDocument <> nil then
        begin
          Result := 0;
          try
            New(NetBuffer);
            repeat
              InternetReadFile(iDocument, NetBuffer, SizeOf(TNetBuffer), BufferSize);
              if BufferSize > 0 then
              begin
                Result := Result + Stream.Write(NetBuffer^, BufferSize);
              end;
            until
              (BufferSize < SizeOf(TNetBuffer));
          finally
            Dispose(NetBuffer);
          end;
        end;
      finally
        internetCloseHandle(iDocument);
      end;
    end;
  finally
    InternetCloseHandle(ihConnect);
  end;
end;


If you call this function with a TFileStream, you have the file on your harddisk. If you have a ZIP, you probably want to unzip the file now, use a component that can do this (I think there are some around). The problem is that an application cannot replace itself (because it is write protected while it is running). The solution would be to call another application and terminate the first one. The second one has to update the first one (maybe wait a while until it is really terminated and not write protect any more) and start it again. If you just have to update non-executable files this is much easier. Another solution would be a separate update-application, that the user can call from somewhere (after he has closed the main application).

Creating a form without a title bar

Problem/Question/Abstract:

How can I create a form that doesn't have a caption, but can be re-sized?

Answer:

Solve 1:

As they say, "There's more than one way to skin a cat," and I can't agree more as far as programming is concerned. Let me share a little anecdote with you...

Being the "artistic dude" in my company, I'm always in search of new ways to present information to users. I do this by creating non-standard user interfaces (which I find rather boring), spicing them up with graphics and multimedia features. My philosophy centers around this question: Why should information retrieval be a boring task? Well, it shouldn't. And an extension to this question could be: Why do business programs have to all look the same? Well, they don't. So I choose to build "odd" business user interfaces.

My latest designs have followed game interfacess that use a plethora of high- resolution graphics and captionless forms (this is where it all kicks in). In the past, I didn't need my forms to move anywhere. But as my interfaces have become more complex, I've had to start providing ways to move them. Unfortunately, the method that I employed in the original article here, didn't account for clicking only in a certain area on a form. You just click and hold the mouse button down anywhere on the form, and the form will move. Unfortunately, that isn't always the best solution.

For instance, with one of my forms, I created a "pseudo" caption by aligning a TPanel at the top of the client area of my form. There's a bit more functionality built into the panel, but I wanted it to act very much like a regular caption: a click and drag would drag the form, and a double-click would maximize it. With that in mind, I set about writing the panel's click and drag method using what I originally wrote as a base. It didn't work. So doing a little research and asking a couple of questions around the newsgroups, Kerstin Thaler, a very helpful person, showed me a real cool method for implementing what I needed to do. Here it is:

procedure TMainFrm.Panel1MouseDown(Sender: TObject; Button:
  TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  SC_DRAGMOVE = $F012;
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
  end;
end;

This is such incredibly easy code! Instead of overriding the default NC_HITTEST message handler, I could accomplish form movement from the MouseDown of my panel! Basically, all the method does is send a WM_SYSCOMMAND message to the form with the SC_DRAGMOVE constant to perform a drag move. Kerstin did say, that the $F012 isn't documented. But hey! the method works and it works well. So if you have a captionless form and want to move it by dragging from one of its child components, this is the way to do it!


Solve 2:

Many folks would say, "Just set the BorderStyle of the form to bsNone and you'll remove the caption." However, there's a problem with that suggestion: Not only do you lose the caption bar, you lose the entire border, which means you can't resize the form. The only way to get around this is to go behind the scenes in Delphi. Fortunately, it's a relatively simple process.

Delphi is not just ObjectPascal; it is also a very effective wrapper of the Windows API (Don't worry, we won't get into the Windows API too much in this article). In Windows, every window is created using one of two standard functions: CreateWindow and CreateWindowEx. CreateWindow makes a window with standard window styles, while CreateWindowEx is the same as CreateWindow, but you can add extended window styles to the window you want to create. (I encourage you to read through the help file for a thorough discussion of these two API calls since I won't be going into detail with these topics.)

When a form is created in Delphi, a call is made to CreateWindowEx &mdash TForm's Create method is the wrapper function for this call &mdash and Create passes a record structure to CreateWindowsEx through a virtual method of TForm called CreateParams.

CreateParams is a virtual method of TForm. This means you can override it which, in turn, means you can change the default style of a window when it's created to suit your particular needs. For our purposes, we want to eliminate the caption. That's easily done by changing the style bits of the LongInt Style field of the TCreateParams structure, the record that's passed to CreateWindowEx. Look at the code; we'll discuss particulars below:

unit NoCap;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Buttons, BDE, DB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    {Here's what we're overriding}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMNCHitTest(var Msg: TWMNcHitTest); message WM_NCHITTEST;
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := (Style or WS_POPUP) and (not WS_DLGFRAME);
  {or... Style := Style + WS_POPUP - WS_DLGFRAME; which is the
   equivalent to the above statement}
end;

procedure TForm1.WMNCHitTest(var msg: TWMNCHitTest);
begin
  inherited;
  if (msg.Result = htClient) then
    msg.Result := htCaption;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

end.

Notice in the line in CreateParams where I set the Style for the form: Style := (Style OR WS_POPUP) AND (NOT WS_DLGFRAME);. My first bit manipulation is Style OR WS_POPUP. This means give me the default style bits and make the window a regular pop-up window with a resizeable border. The second portion says don't include a dialog frame. With respect to this, the WS_DLGFRAME will produce a frame typical of dialog boxes. By masking it out, you remove the title bar. WS_POPUP ensures you have a resizeable border with which to work.

What about the WMNCHitTest message handler? Well, if you have a form with no title bar, you have absolutely no way to move it, because by convention, forms are moved by dragging the title bar. By trapping a mouse hit with the WM_NCHITTEST message and changing the default behavior of the mouse hit, you can allow dragging of the form from the client area.

Read through the Windows API help and look at all the style bits you can set. Play with different combinations to see what you get.

How to set the printer paper size (2)

Problem/Question/Abstract:

How I can select the printer's papersource through code? How I can read the printer default setting papersource in my Delphi program?

Answer:

{ ... }
var
  aDrvName, aPrtName, aPortName: array[0..127] of Char;
  aDeviceMode: THandle;
  PDevMode: ^TDevMode;
  i: Integer;
begin
  with Printer do
  begin
    GetPrinter(aDrvName, aPrtName, aPortName, aDeviceMode);
    PDevMode := GlobalLock(aDeviceMode);
    try
      if PDevMode^.dmPaperSize = DMPAPER_A4 then
        ShowMessage('A4')
      else if PDevMode^.dmPaperSize = DMPAPER_A3 then
        ShowMessage('A3')
      else
      begin
        ShowMessage('Size not supported!' + #13 + 'Resetting papersize to A4');
        PDevMode^.dmPaperSize := DMPAPER_A4;
      end;
    finally
      GlobalUnlock(aDeviceMode);
    end;
  end;
end;

How to save and load a TList to / from a stream

Problem/Question/Abstract:

Can anyone tell me how to stream a TList to a file? Given:

type
  PassWordItem = class(TObject)
    accountName: string[30];
    userName: string[25];
    passWd: string[10];
  end;

and...

PassWdList: TList;

How do I stream the contents of PassWdList to a file, and subsequently load TList from the file?

Answer:

Lets add a couple of methods to the PassWordItem class:


PassWordItem = class(TObject)
public
  accountName: string[30];
  userName: string[25];
  passWd: string[10];

  procedure SaveToStream(s: TStream);
  constructor CreatefromStream(S: TStream);
end;


With that you can write two procedures (or methods of a TPasswordList class derived from TList):


procedure SavePasswordlist(pwl: TLIst; S: TStream);
var
  i: Integer;
begin
  Assert(Assigned(pwl));
  Assert(Assigned(S));
  i := pwl.count;
  S.Write(i, sizeof(i));
  for i := 0 to pwl.count - 1 do
    PasswordItem(pwl[i]).SaveToStream(S);
end;

procedure LoadPasswordList(pwl: TList; S: TStream);
var
  count, n: Integer;
begin
  Assert(Assigned(pwl));
  Assert(Assigned(S));
  S.Read(count, sizeof(count));
  pwl.Capacity := count;
  for n := 1 to count do
    pwl.Add(PasswordItem.CreatefromStream(S));
end;

procedure Passworditem.SaveToStream(s: TStream);
begin
  Assert(Assigned(S));
  S.Write(accountname, Sizeof(accountname));
  S.Write(username, sizeof(username));
  S.Write(passwd, sizeof(passwd));
end;


constructor CreatefromStream(S: TStream);
begin
  Assert(Assigned(S));
  inherited Create;
  S.Read(accountname, Sizeof(accountname));
  S.Read(username, sizeof(username));
  S.Read(passwd, sizeof(passwd));
end;

How to toggle the AlwaysOnTop property of the Windows Taskbar

Problem/Question/Abstract:

Can anyone tell me how to set and reset the Windows TaskBar AlwaysOnTop property from within my application?

Answer:

procedure TForm1.Button1Click(Sender: TObject);
var
  hw: HWND;
begin
  hw := FindWindow('Shell_TrayWnd', nil);
  if hw <> 0 then
  begin
    if (GetWindowLong(hw, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0 then
    begin
      label1.caption := 'Taskbar is topmost';
      SetWindowPos(hw, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
    end
    else
    begin
      label1.caption := 'Taskbar is not topmost';
      SetWindowPos(hw, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
    end;
  end;
end;

Get notified when another application terminates

Problem/Question/Abstract:

My application is starting processes invoking ShellExecute API calls. These processes are manipulating files stored in a database BLOB field. I'd like to be notified when the external application terminates in order to save shanges made on the file. My idea was to use windows hooks, but I didn't guess exactly how. ShellExecute returns the Instance Handle of the application that was run (or DDE handle).

Answer:

Solve 1:

How about using the WndProc procedure and listening for the WM_QUERYENDSESSION in the main application, and broadcasting another message to the other one. Then your applications do what they need to do when they receive the message. For example:

{MainApp:}

const
  EndAppMsg = $FFF8B;

  public

  procedure WndProc(var Msg: TMessage); override;

procdure TMainForm.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_QUERYENDSESSION then
  begin
    BroadcastSystemMessage(BSF_POSTMESSAGE, BSM_ALLCOMPONENTS, EndAppMsg, 0, 0)
  end
  else
    inherited;
end;

And then use the WndProc again in the other applications that the main application calls, and listen for the EndAppMsg message. When it is recived execute the code that you need to execute. For example:

{Client/Worker App}

procedure WndProc(var Msg: Tmessage);
const
  EnaAppMsg = $FFF8B;
begin
  if Msg.Msg = EndAppMsg then
  begin
    {Execute your code here or call another procedure to execute the code}
  end
  else
    inherited;
end;


Solve 2:

You might try using ShellExecuteEx instead, then using the returned hProcess in a WaitForSingleObject call. Here's an example I used in a small demo application:

uses
  Windows, ShellApi;

var
  Info: TShellExecuteInfo;
begin
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.Wnd := Handle;
  Info.lpVerb := 'open';
  Info.lpFile := 'C:\SomeTextFile.Text'; {Change me!}
  Info.lpParameters := nil;
  Info.lpDirectory := nil;
  Info.nShow := SW_SHOW;
  if (ShellExecuteEx(@Info)) then
  begin
    WaitForSingleObject(Info.hProcess, INFINITE);
    MessageBox(Handle, 'You closed the app I launched!', 'Finished!', MB_OK);
    CloseHandle(Info.hProcess);
  end;
end;

I'm not sure if you want your entire application becoming unresponsive while the launched application is running (the WaitForSingleObject call doesn't return until the application is closed), but if you don't, you might consider launching individual threads for each ShellExecuteEx, then using WaitForSingleObject in those threads (and writing an OnTerminate handler for the thread object to determine when the application finally finished).