Komponente für einen erweiterten Fontdialog?

[Sailor]

Du könntest den Fontdialog erweitern. Ich habe das mal für den Opendialog gemacht, siehe Anhang. Weiß allerdigs nicht, ob das beim Fontdialog auch so geht.

Delphi-Quellcode:

UNIT DataDlg;

 INTERFACE

  USES SysUtils,
       Windows,
       Messages,
       Classes,Controls,StdCtrls,Dialogs,Graphics,
       ExtCtrls,ExtDlgs,Buttons;

  TYPE
   TLoadDataDlg = CLASS(TOpenDialog)
                   PRIVATE
                    FPreviewPanel: TPanel;
                     FPreviewMemo: TMemo;

                    PROCEDURE DoOnTypeChange(sender:TObject);

                   PROTECTED
                    PROCEDURE DoClose;           OVERRIDE;
                    PROCEDURE DoSelectionChange; OVERRIDE;
                    PROCEDURE DoShow;            OVERRIDE;

                    PROCEDURE PreviewKeyPress(sender:TObject; VAR key:Char);

                   PUBLIC
                    CONSTRUCTOR Create(a_owner:TComponent); OVERRIDE;
                    DESTRUCTOR Destroy;                     OVERRIDE;

                    FUNCTION Execute:Boolean;               OVERRIDE;

                    CLASS FUNCTION LoadData(parent:TComponent; file_exts:TStringList; VAR test_file:TFileName):Boolean;
                  END;

 IMPLEMENTATION

  USES StrUtils,
       Consts,
       Forms,CommDlg,Dlgs,
       LalrGlob,MyIOUtils,AppMsg;

// Pascal file ( *.pas) | *.pas | Any file ( *.*) | *.*

  PROCEDURE TLoadDataDlg.DoOnTypeChange(sender:TObject);
   VAR
    dlg_filter: String;
     file_name: TFileName;
             i: Integer;
             j: Integer;
             k: Integer;

   CONST
    cb_Filename_Id = 1148;

   BEGIN
    file_name := '*.*';
    dlg_filter := Filter + ' |';
    j := 2*FilterIndex - 1;
    k := 0;
    FOR i:=1 TO Length(dlg_filter)
     DO IF dlg_filter[i] = '|'
         THEN BEGIN
               Inc(k);
               IF k = j
                THEN BEGIN
                      j := i + 1;
                      FOR k:=j TO Length(dlg_filter)
                       DO IF dlg_filter[k] = '|'
                           THEN BEGIN
                                 file_name := Trim(Copy(dlg_filter,j,k-j-1));
                                 Break
                                END;
                      Break
                     END
              END;
    SendMessage(GetParent(Handle),cdm_SetControlText,Edt1,Integer(PChar(file_name)));
    SendMessage(GetDlgItem(GetParent(Handle),idOk),bm_Click,0,0)
   END; {OF PROCEDURE TLoadDataDlg.DoOnTypeChange}

  CONSTRUCTOR TLoadDataDlg.Create(a_owner:TComponent);
   BEGIN
    INHERITED Create(a_owner);
    OnTypeChange := DoOnTypeChange;
    FPreviewPanel := TPanel.Create(Self);
    WITH FPreviewPanel
     DO BEGIN
         Name := 'PreviewPanel';
         Caption := '';
         SetBounds(200,10,250,200);
         BevelOuter := bvNone;
         BevelWidth := 1;
         TabOrder := 1;
         FPreviewMemo := TMemo.Create(Self);
         WITH FPreviewMemo
          DO BEGIN
              Parent := FPreviewPanel;
              Font.Name := 'Courier New';
              Font.Size := 8;
              ReadOnly := True;
              ScrollBars := ssBoth;
              WordWrap := False;
              SetBounds(0,0,250,200);
              Align := alClient
            END
        END
    END; {OF CONSTRUCTOR TLoadDataDlg.Create}

  DESTRUCTOR TLoadDataDlg.Destroy;
   BEGIN
    FPreviewMemo.Free;
    FPreviewPanel.Free;
    INHERITED Destroy
   END; {OF DESTRUCTOR TLoadDataDlg.Destroy}

  PROCEDURE TLoadDataDlg.DoSelectionChange;
   FUNCTION ValidFile(CONST FileName:String):Boolean;
    BEGIN
     Result := GetFileAttributes(PChar(FileName)) <> $FFFFFFFF
    END; {OF FUNCTION ValidFile}

   VAR
      tmp_data: TStringList;
     full_name: String;
    valid_file: Boolean;

   BEGIN
    full_name := FileName;
    valid_file := FileExists(full_name) and ValidFile(full_name);
    IF valid_file = True
     THEN BEGIN
           tmp_data := TStringList.Create;
           TRY
            TRY
             tmp_data.LoadFromFile(full_name);
             FPreviewMemo.Lines.Assign(tmp_data);
            EXCEPT
             valid_file := False
            END
           FINALLY
            tmp_data.Free
           END
          END;
    IF valid_file = False
     THEN BEGIN
          END;
    FPreviewMemo.Invalidate;
    INHERITED DoSelectionChange
   END; {OF PROCEDURE TLoadDataDlg.DoSelectionChange}

  PROCEDURE TLoadDataDlg.DoClose;
   BEGIN
    INHERITED DoClose;
    Application.HideHint
   END; {OF PROCEDURE TLoadDataDlg.DoClose}

  PROCEDURE TLoadDataDlg.DoShow;
   VAR
    prev_rect: TRect;
    stat_rect: TRect;

   BEGIN
    GetClientRect(Handle,prev_rect);
    stat_rect := GetStaticRect;
    prev_rect.Left := stat_rect.Left + (stat_rect.Right - stat_rect.Left);
    Inc(prev_rect.Top,4);
    FPreviewPanel.BoundsRect := prev_rect;
    FPreviewPanel.ParentWindow := Handle;
    INHERITED DoShow
   END; {OF PROCEDURE TLoadDataDlg.DoShow}

  PROCEDURE TLoadDataDlg.PreviewKeyPress(sender:TObject; VAR key:Char);
   BEGIN
    IF Key = #27
     THEN TForm(sender).Close
   END; {OF PROCEDURE TLoadDataDlg.PreviewKeyPress}

  FUNCTION TLoadDataDlg.Execute:Boolean;
   BEGIN
    IF NewStyleControls = True
     THEN Template := 'DLGTEMPLATE'
     ELSE Template := NIL;
    Result := INHERITED Execute
   END; {OF FUNCTION TLoadDataDlg.Execute}

  CLASS FUNCTION TLoadDataDlg.LoadData(parent:TComponent; file_exts:TStringList; VAR test_file:TFileName):Boolean;
   VAR
    data_dlg: TLoadDataDlg;
    data_ext: String;
     cur_ext: String;

   BEGIN
    data_ext := BuildFileFilter(file_exts);
    data_dlg := TLoadDataDlg.Create(parent);
    TRY
     WITH data_dlg
      DO BEGIN
         Title := TextOf('LoadTestData');
         InitialDir := ExtractFilePath(test_file);
         IF Length(ExtractFileExt(test_file)) = 0
          THEN cur_ext := FirstFilterExt(data_ext)
          ELSE BEGIN
                cur_ext := '*' + ExtractFileExt(test_file);
                IF GetFilterIndexOf(cur_ext,data_ext) = Undefined
                 THEN cur_ext := FirstFilterExt(data_ext)
               END;
         DefaultExt := DefaultFilterExt(cur_ext);
         FileName := cur_ext;
         Filter := data_ext;
         FilterIndex := GetFilterIndexOf(cur_ext,data_ext);
         Options := [ofHideReadOnly,ofFileMustExist,ofEnableSizing];
         IF Execute = True
          THEN BEGIN
                Result := True;
                test_file := FileName
               END
          ELSE Result := False
         END;
    FINALLY
     data_dlg.Free
    END
   END; {OF CLASS FUNCTION TLoadDataDlg.LoadData}

 END
.