generalvcl.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2004-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit GeneralVCL;

{Some simple functions working with the VCL (and maybe CLX).
}

interface

uses
{$IFNDEF LINUX}
     Windows,
{$ENDIF}
{$IFDEF VER120}
     Messages,
{$ENDIF}
     Classes,
     Forms,
{$IFDEF LINUX}
     QDialogs,
     Controls,
{$ENDIF}
{$IFDEF VER120}
     Controls, CommCtrl, ComCtrls,
{$ENDIF}
     StdCtrls;



{$IFDEF LINUX}

//Shows the form modal.
procedure ShowFormModal(TheForm: TForm);

{$ENDIF}


//Asks the user for a directory.
function AskForDirectory(const Caption: String;
                         var Directory: String): Boolean;

//Asks the user for a directory, it may be a relative directory.
function AskForRelativeDirectory(const Caption: String;
                                 var Directory: String): Boolean;



//Copies the text of the selected items of the list box into the clip board.
procedure SelectedListBoxItemsToClipboard(ListBox: TListBox);
//Copies the text of all items of the list box into the clip board.
procedure ListBoxItemsToClipboard(ListBox: TListBox);
//Saves the text of all items of the list box to the file the user selects.
function ListBoxItemsToFile(ListBox: TListBox;
                            HelpContext: THelpContext): Boolean;



    //whether ~[link RegisterMemoToHideVerticalScrollbar] should actually do
    //something, if this variable is False, the procedure will do nothing
var OptimizeMemoScrollBars: Boolean = True;

//Makes sure the vertical scrollbar of the memo is only visible when it is
//needed. The memo has probably to be read-only.
procedure RegisterMemoToHideVerticalScrollbar(Memo: TMemo);


{$IFNDEF LINUX}

//Adds a HTML snippet to the rich edit while interpreting some simple tags.
procedure AppendHTMLSnippetToRichEdit(Snippet: String; RichEdit: TRichEdit);

{$ENDIF}




{$IFDEF VER120}

     {The TreeView in Delphi 4 has a bug, writing one character too much, if
      the labels of items in the TreeView are too long (in Win98: longer than
      159 characters). This is fixed in Delphi 7, I don't know in which version
      this has been done.~[br]
      The same error is in TListView.

      On the other hand I found a new error, that it ~[em not] fixed in this
      class, it seems to pop up when the mouse pointer is moved over a line
      that is not fully visible and a hint windows should show the whole text.
      But that may be a Windows 98 bug and not Delphi, hard to track, so I'm
      gonna ignore it for now. It also only shows up, after one of the
      custom-draw tree-views had been shown. }
type TFixedTreeView = class(TTreeView)
     private
       //Fixes the maximum allowed length to include the terminating
       //0-character.
       procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
     end;


{$ENDIF}




implementation

uses SysUtils, 
     Dialogs,
{$IFNDEF LINUX}
     ShlObj, ActiveX, Graphics, RichEdit,
 {$IFDEF VER120}
     FileCtrl,
 {$ENDIF}
     ClipBrd,
{$ELSE}
     QClipbrd,
     QForms, QGraphics,
{$ENDIF}
     General, UFilePaths;




{$IFDEF LINUX}

{Shows the form modal. With Kylix (Qt?) you can only show one modal window at
 every time, so a modal window can't open a non-modal window, for instance as a
 small helper-window. This procedure shows is modal similar like it is done in
 Delphi under Windows.
~param TheForm the form to show modal }
procedure ShowFormModal(TheForm: TForm);
var       List         :TList;           //list of deactivated forms
          i            :Integer;         //counter through forms
          Form         :TForm;           //each form
begin
 List := TList.Create;                   //create list for deactivated forms
 try
   try
     for i := 0 to Screen.FormCount - 1 do //check each form
      begin
       Form := Screen.Forms[i];              //get the form
       if Form.Visible and Form.Enabled then //form currently in use?
        begin
         List.Add(Form);          //add to the list in order to enable it later
         Form.Enabled := False;                //disable the form
        end;
      end; //for i := 0 to Screen.FormCount - 1

      TheForm.ModalResult := mrNone;         //form not closed yet
      TheForm.Show;                          //show the form
      //wait until form closed or application terminated
      while not Application.Terminated and
            (TheForm.ModalResult = mrNone) and TheForm.Visible do
       Application.HandleMessage;
      TheForm.Hide;                          //hide (un-show) the form

   finally
    for i := 0 to List.Count - 1 do      //enable all previously enabled forms
     TForm(List[i]).Enabled := True;
   end;
 finally
  List.Free;                             //free list of deactivated forms
 end;
end;

{$ENDIF}






{$IFNDEF LINUX}


     //information for the dialog in order to browse for a directory
type TDirectoryBrowseInfo = record
       //the preselected directory
       InitialDirectory: String;
       //the help context of the dialog
//       HelpContext: THelpContext;
     end;


{Sets the initial directory in the dialog.
 type: ShlObj.TFNBFFCallBack / ShlObj.BFFCALLBACK
~param Wnd    Handle to the browse dialog box.
~param uMsg   Value identifying the event. One of:~[br]
              BFFM_INITIALIZED Dialog box has finished initializing.~[br]
              BFFM_SELCHANGED  The selection has changed.
~param lParam Message-specific value.
~param lpData Application-defined value: the initial directory (PChar)
~result always 0 }
function AskForDirectory_BFFCALLBACK(Wnd: HWND; uMsg: UINT;
                                     lParam, lpData: LPARAM): Integer stdcall;
begin
 if uMsg = BFFM_INITIALIZED then     //dialog intialized?
  begin                                //set initial directory
   SendMessage(Wnd, BFFM_SETSELECTION, Windows.LPARAM(BOOL(LongBool(True))),
               Integer(PChar(TDirectoryBrowseInfo(Pointer(lpData)^).
                                                           InitialDirectory)));
{
   SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0,
               Integer(PChar('Remember to use an empty directory!')));
}
{
   SetWindowContextHelpId(Wnd,
                          TDirectoryBrowseInfo(Pointer(lpData)^).HelpContext);
}
  end;
 Result := 0;
end;


{Asks the user for a directory with the standard windows dialog.
~param Caption   the caption of the dialog
~param Directory in: the default directory; out: the selected directory
~result if the user selected a directory }
function AskForDirectory(const Caption: String;
                         var Directory: String): Boolean;
var      ShellMalloc    :IMalloc;              //a global memory manager
         Buffer         :PChar;                //for the selected directory
         ExtBrowseInfo  :TDirectoryBrowseInfo; //extended browse information
         BrowseInfo     :TBrowseInfo;          //normal browse information
         ItemIDList     :PItemIDList;          //ID of the selected directory
begin
 //delete trailing backslash
 if (Directory <> '') and (Directory[length(Directory)] = '\') and
    ((Length(Directory) <> 3) or (Directory[2] <> ':') or
     not (Directory[1] in ['A'..'Z', 'a'..'z'])) then
  Delete(Directory, Length(Directory), 1);

 Result := False;
 //get global memory manager
 if (ShGetMalloc(ShellMalloc) = S_OK) and Assigned(ShellMalloc) then
  begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);     //get memory for the path
   try
     ExtBrowseInfo.InitialDirectory := Directory;   //set extended browse info

     FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);   //set browse information
     BrowseInfo.hwndOwner := Application.Handle;
     BrowseInfo.pidlRoot := nil;                    //show all directories
     BrowseInfo.pszDisplayName := Buffer;
     BrowseInfo.lpszTitle := PChar(Caption);
     BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;  // or BIF_STATUSTEXT;
     //set initial directory here
     BrowseInfo.lpfn := AskForDirectory_BFFCALLBACK;
     BrowseInfo.lParam := Integer(@ExtBrowseInfo); //set extended browse info

     ItemIDList := ShBrowseForFolder(BrowseInfo); //show dialog

     Result := Assigned(ItemIDList);                //something selected?
     if Result then
      begin                                         //get path of the item
       Result := ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);                //free item
       Directory := Buffer;
      end;
   finally
    ShellMalloc.Free(Buffer);                 //free memory for path
   end;
  end;
end;




{$ELSE}


{Asks the user for a directory with the standard Qt dialog.
~param Caption   the caption of the dialog
~param Directory in: the default directory; out: the selected directory
~result if the user selected a directory }
function AskForDirectory(const Caption: String;
                         var Directory: String): Boolean;
var      Dir            :WideString;    //the selected directory
begin
 Dir := '';
 Result := SelectDirectory(Caption, '', Dir, True); //ask for directory
 if Result then