Spaltenansicht in einem Hint

[punker76]

Hallo Leute.

Ich hatte dazu schon mal eine Anfrage ins Forum gepostet. Hab mir dann aber doch meine eigene Gedanken dazu gemacht. hier mein Ergebnis:

Die Benutzung der Klasse TMyHint:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses
  teMyHint;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {* eigene Hintklasse aktivieren }
  HintWindowClass := TMyHint;
  Application. HintHidePause:= 10000;

  Button1. Hint:=
    'Spalte 1<@=80@>Spalte 2<@=120@>Spalte 3' + ';' +
    'Ein Test mit ner langen, langen, sehr langen Zeile, ich hoffe es klappt?' + ';' +
    'Ein Test<@=80@>Noch ein Test<@=120@>Noch ein Test' + ';' +
    'Ein Test<@=80@>Noch ein Test<@=120@>blubb' + ';' +
    'Ein Test<@=80@>Noch ein Test' + ';' +
    '1235678';
end;

end.

Die Klasse TMyHint:

Delphi-Quellcode:

unit teMyHint;
//==============================================================================
//  Klasse:    TMyHint
//  Author:    Jan Karger
//  Datum:    26.01.2004
//  Feedback:    [email][e-mail][/email]
//  Benutzung:    Jeder kann diesen Code benutzen, weitergeben oder auch verändern,
//                verbessern und dann weitergeben und mir, wenn Verbesserungen
//                erfolgt sind, vielleicht ein kleines Feedback geben.
//==============================================================================
//  Einbinden in ein Projekt: in FormCreate
//
//  HintWindowClass := TMyHint;
//  Application. ShowHint := False;
//  Application. ShowHint := True;
//
//  Formatierung des Hints:
//
//  Hint:=
//    'Ein Test' + ';' +
//    'Ein Test<@=80@>Noch ein Test<@=120@>Noch ein Test' + ';' +
//    'Ein Test<@=80@>Noch ein Test<@=120@>blubb' + ';' +
//    'Ein Test<@=80@>Noch ein Test' + ';' +
//    '1235678';
//
//  <@=80@>   Spaltenbreite
//  ';'      Trenner für den Zeilenumbruch
//==============================================================================

interface

uses
  Windows, Classes, Graphics, Controls, Forms;

type
  TMyHint = class(THintWindow)
  private
    procedure MyCalcHintRect (var ARect: TRect; AHint: string);
  public
    constructor Create (AOwner: TComponent); override;
    function CalcHintRect (MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  protected
    procedure Paint; override;
  published
    property Caption;
  end;

var
  gMyHintColor      : TColor;

  gMyHintFont      : string;
  gMyHintFontStyle   : TFontStyles;
  gMyHintFontSize   : integer;

  gZeilenUmbruch   : Char;

implementation

uses
  SysUtils, Math;

constructor TMyHint. Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  {* eigenes Aussehen des Hints: Color, Schriftart, Schriftgrösse }
  Color := gMyHintColor;
  if gMyHintFont <> '' then begin
    Canvas. Font. Name   := gMyHintFont;
    Canvas. Font. Style   := gMyHintFontStyle;
    Canvas. Font. Size   := gMyHintFontSize;
  end
  else begin
    Canvas. Font := Screen. HintFont;
  end;
  Canvas. Brush. Style := bsClear;
end;

{** Berechnet das Hint-Rechteck und den Clientbereich für den Text }
procedure TMyHint. MyCalcHintRect (var ARect: TRect; AHint: string);
var
  iIndex   : integer;
  iColPos   : integer;
  iPos1, iPos2   : integer;
  iColWidth   : integer;
  iMax      : integer;
  s      : string;
  sTemp      : string;
  iTop      : integer;
  iLeft      : integer;
  iRight   : integer;
  MyHintList   : TStringList;
  iMyPos   : integer;
  bIsFertig   : boolean;
begin
  MyHintList   := TStringList. Create;
  try
    {* den Hint zerpflücken, durch den angegebenen Zeilentrenner }
    iMyPos:= Pos (gZeilenUmbruch, AHint);
    if iMyPos > 0 then begin
      bIsFertig:= FALSE;
      repeat
   MyHintList. Add (Copy (AHint, 1, iMyPos-1));
   Delete (AHint, 1, iMyPos);
   iMyPos:= Pos (gZeilenUmbruch, AHint);
   if iMyPos = 0 then begin
     MyHintList. Add (AHint);
     bIsFertig:= TRUE;
   end;
      until bIsFertig;
    end
    else
      MyHintList. Add (AHint);

    if MyHintList. Count = 0 then EXIT;

    Inc (ARect.Left, 2);
    Inc (ARect.Top, 2);

    iTop:= 0;
    iMax:= 0;
    for iIndex:= 0 to MyHintList. Count - 1 do 
    begin
      s:= MyHintList [iIndex];

      ARect. Bottom:= iTop + Canvas. Textheight (s) + 4;
      iLeft:= 0;
      iColPos:= Pos ('<@=', s);
      if iColPos > 0 then 
      begin
   while iColPos > 0 do 
        begin
          iPos1:= iColPos + 3;
          iPos2:= Pos ('@>', s);
          if iPos2 = 0 then EXIT;
          iColWidth:= StrToIntDef (Copy (s, iPos1, iPos2-iPos1), 0);
          if iColWidth = 0 then EXIT;
          sTemp:= Copy (s, 1, iColPos-1);
          Delete (s, 1, iPos2+1);

          iRight:= iLeft+iColWidth;
          iMax:= Max (iMax, iRight);
          ARect. Right:= iMax;
          Canvas. TextRect (ARect, iLeft+2, iTop+2, sTemp);
          iLeft:= iRight;

          iColPos:= Pos ('<@=', s);
          if iColPos = 0 then begin
            iMax:= Max (iMax, iLeft + Canvas. TextWidth (s) + 8);
            ARect. Right:= iMax;
            Canvas. TextRect (ARect, iLeft+2, iTop+2, s);
          end;
        end;
      end
      else begin
        iMax:= Max (iMax, iLeft + Canvas. TextWidth (s) + 8);
        ARect. Right:= iMax;
        Canvas. TextRect (ARect, iLeft+2, iTop+2, s);
      end;
      s:= MyHintList [iIndex];
      iTop:= iTop + Canvas. Textheight(s) + 2;
    end;
  finally
    MyHintList. Free;
  end;
end;

procedure TMyHint. Paint;
var
  R   : TRect;
begin
  {* hier muss nochmal explizit die Farbe des Hints angegeben werden }
  Color   := gMyHintColor;
  {* Text in Hint-ClientRechteck zeichnen }
  R   := ClientRect;
  MyCalcHintRect (R, Caption);
end;

function TMyHint. CalcHintRect (MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin
  {* Hint-Rechteck errechnen }
  Result := Rect (0, 0, 0, 0);
  MyCalcHintRect (Result, AHint);
end;

initialization
  gMyHintColor      := clInfoBk;
  gMyHintFont      := {'Arial'}'';      // wenn leer, dann Standardfont
  gMyHintFontStyle   := [fsBold];
  gMyHintFontSize   := 9;
  gZeilenUmbruch   := ';';

finalization

end.

Viel Spass damit

punker76

[edit=sakura] Doppelpost (wenn auch in anderer Sparte) gelöscht. Mfg, sakura[/edit]
[edit=Chakotay1308]Kleine Korrektur und SourceCode angehangen. Mfg, Chakotay1308[/edit]
[edit=Matze]Code formatiert. Mfg, Matze[/edit]