generalvcl.pas

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

  Directory := Dir;                                 //and return it
end;

{$ENDIF}




{Asks the user for a directory, it may be a relative directory.
~param Caption   the caption of the dialog
~param Directory in: the default directory; out: the selected directory;
                 if a relative directory was inserted, the returned directory
                 may also be relative
~result if the user selected a directory }
function AskForRelativeDirectory(const Caption: String;
                                 var Directory: String): Boolean;
var      S            :String;           //the currently selected path
         IsRelative   :Boolean;          //whether the current path is relative
begin
 S := Directory;                         //get the current path and show dialog
 IsRelative := DirectoryExists(S) and not IsAbsolutePath(S);
{$IFNDEF LINUX}
 if IsRelative then                      //is a relative path?
  S := ExpandFileName(S);                  //function needs absolute path
{$ENDIF}
 Result := AskForDirectory(Caption, S);  //let the user select a directory
 if Result then                          //directory selected?
  begin
   S := S + PathDelimiter;                 //add the path delimiter
   if IsRelative then                      //was a relative path?
    begin                                    //make it also relative
     S := ExtractRelativePath(GetCurrentDir + PathDelimiter, S);
     if S = '' then                          //is the current path?
      S := '.' + PathDelimiter                 //use '.' instead
     else
      if (S[1] <> '.') and not IsAbsolutePath(S) then //is a sub-directory?
       S := '.' + PathDelimiter + S;             //prepend '.' and delimiter
    end;
   Directory := S;                         //return the path
  end;
end;








{Copies the text of the selected items of the list box into the clip board.
~param ListBox the list box whose selected items should be copied }
procedure SelectedListBoxItemsToClipboard(ListBox: TListBox);
var       S                    :String;        //the text to copy
          i                    :Integer;       //counter through the items
begin
 S := '';
 for i := 0 to ListBox.Items.Count - 1 do      //for all items
  if ListBox.Selected[i] then                    //that are selected
   S := S + ListBox.Items[i] + LineDelimiter;      //add them to the text
 if S <> '' then                               //some selected?
  Clipboard.AsText := S;                         //"copy" it
end;

{Copies the text of all items of the list box into the clip board.
~param ListBox the list box whose items should be copied }
procedure ListBoxItemsToClipboard(ListBox: TListBox);
var       S                      :String;      //the text to copy
          i                      :Integer;     //counter through the items
begin
 i := ListBox.Items.Count;
 if i <> 0 then                                //not empty?
  begin
//   Clipboard.AsText := ListBox.Items.Text;
   S := '';
   for i := 0 to i - 1 do                        //for all items
    S := S + ListBox.Items[i] + LineDelimiter;     //add to the text
   Clipboard.AsText := S;                        //"copy" the text
  end;
end;

{Saves the text of all items of the list box to the file the user selects.
~param ListBox     the list box whose items should be saved
~param HelpContext the help context to use to show the dialog
~result whether the user has chosen a file and the messages have been saved }
function ListBoxItemsToFile(ListBox: TListBox;
                            HelpContext: THelpContext): Boolean;
var      Dialog     :TSaveDialog;              //dialog to chose the file
begin
 Dialog := TSaveDialog.Create(nil);            //create a file save - dialog
 try
   Dialog.HelpContext := HelpContext;          //use the help context
   Dialog.DefaultExt := 'TXT';
   Dialog.Filter := 'Text-Files (*.txt)|*.txt|Log-Files (*.log)|*.log|all files (*)|*';
   Dialog.InitialDir := GetCurrentDir;
   Dialog.Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist,
                      ofEnableSizing, ofShowHelp];
   Dialog.Title := 'Save Log of DelphiDoc';
   Result := Dialog.Execute;                   //show the dialog
   if Result then                              //file to save to chosen?
    ListBox.Items.SaveToFile(Dialog.FileName)    //save the content
 finally
  Dialog.Free;                                 //free the dialog
 end;
end;














{$IFNDEF LINUX}

     //used to access the OnResize event of controls (TMemo's)
     //~see RegisterMemoToHideVerticalScrollbar
type TOnResizeAccessControl = class(TControl);

     {A class needed to listen on a memo as used in
      ~[link RegisterMemoToHideVerticalScrollbar]. }
     TMemoListener = class(TComponent)
     private
       //the memo to listen on
       FMemo: TMemo;
       //the original window procedure for all TMemos
       FMemoWndProc: TWndMethod;

       //A listener on when the memo is shown.
       procedure NewWndProc(var Message: TMessage);
       //Called when the text of a registered memo has changed.
       procedure MemoTextChanged(Sender: TObject);
       //Called when the size of a registered memo has changed.
       procedure MemoResized(Sender: TObject);
     public
       //Creates the objects and starts listening on the memo.
       constructor CreateForMemo(Memo: TMemo);

       //Called when the memo is freed.
       procedure Notification(AComponent: TComponent;
                              Operation: TOperation); override;

     end;



{Creates the objects and starts listening on the memo.
~param Memo the memo to listen on }
constructor TMemoListener.CreateForMemo(Memo: TMemo);
begin
 inherited Create(Memo);               //create the object

 FMemoWndProc := Memo.WindowProc;      //save its window procedure
 FMemo := Memo;                        //and itself

 Memo.FreeNotification(Self);          //we want a notification when it's freed

 Memo.OnChange := MemoTextChanged;     //register us with it
 TOnResizeAccessControl(Memo).OnResize := MemoResized;
 Memo.WindowProc := NewWndProc;

 if FMemo.Showing then                 //is already visible?
  MemoResized(Memo)                      //check it now
 else
  //make sure it isn't recreated when it is finally shown
  FMemo.ScrollBars := ssVertical;
end;

{Called when the memo is freed.
~param AComponent the memo
~param Operation the information that it is freed }
procedure TMemoListener.Notification(AComponent: TComponent;
                                     Operation: TOperation);
begin
 if (Operation = opRemove) and (AComponent = FMemo) then //memo is freed?
  begin
   FMemo.WindowProc := FMemoWndProc;                       //unregister self
   FMemo.OnChange := nil;
   TOnResizeAccessControl(FMemo).OnResize := nil;
//   Destroy;                                                //and free self
  end;

 //and handle the notification (unregister in case of deletion)
 inherited Notification(AComponent, Operation);
end;
















{A listener on when the memo is shown.
~param Message to be sent to the memo }
procedure TMemoListener.NewWndProc(var Message: TMessage);
begin
 FMemoWndProc(Message);                      //let the memo handle it, too

 //memo is shown now?
 if (Message.Msg = CM_SHOWINGCHANGED) and FMemo.Showing then
  if Assigned(TOnResizeAccessControl(FMemo).OnResize) then //no recursion!
   //currently main form is made visible?
   if not GetParentForm(FMemo).Showing then
    //then handle this again when it is completely shown
    PostMessage(FMemo.Handle, CM_SHOWINGCHANGED, 0, 0)
   else
    MemoResized(FMemo);                                       //handle it now
end;

{Called when the text of a registered memo has changed.
~param Sender the memo whose text has been changed }
procedure TMemoListener.MemoTextChanged(Sender: TObject);
begin
 MemoResized(Sender);                        //same handling so far
end;

{Called when the size of a registered memo has changed.
~param Sender the memo whose size has been changed }
procedure TMemoListener.MemoResized(Sender: TObject);
          //options of the vertical scroll bar of the memo
var       ScrollInfo   :TScrollInfo;
begin
 if FMemo.Showing then                  //memo is visible?
  begin
   TOnResizeAccessControl(FMemo).OnResize := nil;  //no recursion, please

   FMemo.ScrollBars := ssVertical;

   ScrollInfo.cbSize := SizeOf(ScrollInfo);   //get options of the scroll bar
   ScrollInfo.fMask := SIF_POS or SIF_RANGE or SIF_PAGE;
//
{
   if GetScrollInfo(FMemo.Handle, SB_VERT, ScrollInfo) then
    GetParentForm(FMemo).Caption := Format('%d - %d: %d - %d',
                                           [ScrollInfo.nMin,
                                            ScrollInfo.nMax,
                                            ScrollInfo.nPage,
                                            ScrollInfo.nPos])
   else
    GetParentForm(FMemo).Caption := 'GetScrollInfo failed!';
//}
   if GetScrollInfo(FMemo.Handle, SB_VERT, ScrollInfo) then
    if ScrollInfo.nPage > UINT(ScrollInfo.nMax) then //it is not necessary?
{     //currently main form is made visible?
     if not GetParentForm(FMemo).Showing then
      //than handle this again when it is completely shown
      PostMessage(FMemo.Handle, CM_SHOWINGCHANGED, 0, 0)
     else
}
     FMemo.ScrollBars := ssNone;                       //remove the scroll bar

    //enable event handler again
   TOnResizeAccessControl(FMemo).OnResize := MemoResized;
  end;
end;

{$ENDIF}


{Peter Below (TeamB) [Jan 2 2006, 16:08 (GMT+1?)] in
 borland.public.delphi.vcl.components.using.win32:

Adjusting a memo to the height required to show all text without scrollbars:

procedure TForm1.Button2Click(Sender: TObject);
var
  rect1, rect2: TRect;
  S: String;
Begin
  s := Memo1.Text;
  memo1.Perform( EM_GETRECT, 0, longint(@rect1));
  rect2 := rect1;
  canvas.font := memo1.font;
  DrawTextEx( canvas.handle, Pchar(S), Length(S), rect2,
              DT_CALCRECT or DT_EDITCONTROL or DT_WORDBREAK or DT_NOPREFIX,
              Nil );
  memo1.Height := memo1.height + rect2.Bottom - rect1.bottom;
end;
}



{Makes sure the vertical scrollbar of the memo is only visible when it is
 needed. The memo has probably to be read-only. The OnChange and OnResize