HintWindow.pas

   1 unit HintWindow;
   2
   3 interface
   4
   5 uses
   6         Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   7         GikoSystem;
   8
   9 type
  10         TGikoPopupType = (gptRaw, gptThread);
  11
  12         TResPopup = class(THintWindow)
  13         private
  14                 FTitle: string;
  15                 FResList: TList;
  16                 FPopupType: TGikoPopupType;
  17                 FHeaderBold: Boolean;
  18         protected
  19                 procedure Paint; override;
  20         public
  21                 constructor Create(AOwner: TComponent); override;
  22                 destructor Destroy; override;
  23                 procedure Add(AHeader: string; ABody: string);
  24                 procedure ClearAllRes;
  25                 function ResCount: Integer;
  26                 function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; override;
  27                 property Title: string read FTitle write FTitle;
  28                 property PopupType: TGikoPopupType read FPopupType write FPopupType;
  29                 property HeaderBold: Boolean read FHeaderBold write FHeaderBold;
  30         end;
  31
  32         PResDataRec = ^TResDataRec;
  33         TResDataRec = record
  34                 FHeader: string;
  35 //              FHeaderHeight: Integer;
  36                 FBody: string;
  37 //              FBodyHeight: Integer;
  38         end;
  39
  40 implementation
  41
  42 const
  43         BODY_INDENT = 5;                //Body\95\94\95ª\82Ì\83C\83\93\83f\83\93\83g\95\9d
  44         TITLE_SPACE = 8;                //\83^\83C\83g\83\8b\82Æ\96{\95¶\8aÔ\82Ì\8d\82\82³
  45         RES_SPACE = 8;                  //\83\8c\83X\8aÔ\8bó\94\92\82Ì\8d\82\82³
  46         HEADER_SPACE = 4;               //\83w\83b\83_\82Æ\96{\95¶\8aÔ\82Ì\8d\82\82³
  47
  48 constructor TResPopup.Create(AOwner: TComponent);
  49 begin
  50         inherited Create(AOwner);
  51         FResList := TList.Create;
  52         FHeaderBold := True;
  53 end;
  54
  55 destructor TResPopup.Destroy;
  56 begin
  57         ClearAllRes;
  58         FResList.Free;
  59         inherited Destroy;
  60 end;
  61
  62 procedure TResPopup.Paint;
  63 var
  64         R: TRect;
  65         i: Integer;
  66         ResData: PResDataRec;
  67         H: Integer;
  68 begin
  69         R := ClientRect;
  70         Inc(R.Left, 2);
  71         Inc(R.Top, 2);
  72         Canvas.Font.Color := Font.Color;
  73         Canvas.Font.Name := Font.Name;
  74         Canvas.Font.Size := Font.Size;
  75         if FPopupType = gptRaw then begin
  76                 Canvas.Font.Style := [];
  77                 DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
  78         end else begin
  79                 if FTitle <> '' then begin
  80                         Canvas.Font.Style := [fsBold];
  81                         H := DrawText(Canvas.Handle, PChar(FTitle), -1, R,
  82                                                                                 DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
  83                         if FResList.Count > 0 then
  84                                 R.Top := R.Top + H + TITLE_SPACE
  85                         else
  86                                 R.Top := R.Top + H;
  87                 end;
  88                 for i := 0 to FResList.Count - 1 do begin
  89                         if i <> 0 then
  90                                 R.Top := R.Top + RES_SPACE;
  91                         ResData := FResList[i];
  92                         //Header
  93                         Canvas.Font.Style := [];
  94                         if FHeaderBold then
  95                                 Canvas.Font.Style := [fsBold];
  96                         H := DrawText(Canvas.Handle, PChar(ResData.FHeader), -1, R,
  97                                                                                         DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
  98                         R.Top := R.Top + H;
  99                         //\83X\83y\81[\83X
 100                         R.Top := R.Top + HEADER_SPACE;
 101                         //Body
 102                         Canvas.Font.Style := [];
 103                         R.Left := R.Left + BODY_INDENT;
 104                         H := DrawText(Canvas.Handle, PChar(ResData.FBody), -1, R,
 105                                                                                 DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
 106                         R.Top := R.Top + H;
 107                         R.Left := R.Left - BODY_INDENT;
 108                 end;
 109         end;
 110 end;
 111
 112 function TResPopup.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
 113 var
 114         i: Integer;
 115         ARect: TRect;
 116         ResData: PResDataRec;
 117 begin
 118         Result := Rect(0, 0, 0, 0);
 119         Canvas.Font.Name := Font.Name;
 120         Canvas.Font.Size := Font.Size;
 121         if FPopupType = gptRaw then begin
 122                 Canvas.Font.Style := [fsBold];
 123                 Result := Rect(0, 0, MaxWidth, 0);
 124                 DrawText(Canvas.Handle, PChar(AHint), -1, Result,
 125                                                  DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
 126         end else begin
 127                 //Title
 128                 if FTitle <> '' then begin
 129                         Canvas.Font.Style := [fsBold];
 130                         ARect := Rect(0, 0, MaxWidth, 0);
 131                         DrawText(Canvas.Handle, PChar(FTitle), -1, ARect,
 132                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
 133                         if Result.Right < ARect.Right then
 134                                 Result.Right := ARect.Right;
 135                         if FResList.Count > 0 then
 136                                 Result.Bottom := Result.Bottom + ARect.Bottom + TITLE_SPACE
 137                         else
 138                                 Result.Bottom := Result.Bottom + ARect.Bottom;
 139                 end;
 140                 for i := 0 to FResList.Count - 1 do begin
 141                         if i <> 0 then
 142                                 Result.Bottom := Result.Bottom + RES_SPACE;
 143                         ResData := FResList[i];
 144                         //Header
 145                         Canvas.Font.Style := [];
 146                         if FHeaderBold then
 147                                 Canvas.Font.Style := [fsBold];
 148                         ARect := Rect(0, 0, MaxWidth, 0);
 149                         DrawText(Canvas.Handle, PChar(ResData.FHeader), -1, ARect,
 150                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
 151                         if Result.Right < ARect.Right then
 152                                 Result.Right := ARect.Right;
 153                         Result.Bottom := Result.Bottom + ARect.Bottom;
 154                         //\83X\83y\81[\83X
 155                         Result.Bottom := Result.Bottom + HEADER_SPACE;
 156                         //Body
 157                         Canvas.Font.Style := [];
 158                         ARect := Rect(0, 0, MaxWidth, 0);
 159                         DrawText(Canvas.Handle, PChar(ResData.FBody), -1, ARect,
 160                                                          DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK);
 161                         if Result.Right < (ARect.Right + BODY_INDENT) then
 162                                 Result.Right := ARect.Right + BODY_INDENT;
 163                         Result.Bottom := Result.Bottom + ARect.Bottom;
 164                 end;
 165         end;
 166         Inc(Result.Right, 6);
 167         Inc(Result.Bottom, 2);
 168 end;
 169
 170 procedure TResPopup.Add(AHeader: string; ABody: string);
 171 var
 172         ResData: PResDataRec;
 173 begin
 174         New(ResData);
 175         ResData.FHeader := AHeader;
 176 //      ResData.FHeaderHeight := 0;
 177         ResData.FBody := ABody;
 178 //      ResData.FBodyHeight := 0;
 179         FResList.Add(ResData);
 180 end;
 181
 182 procedure TResPopup.ClearAllRes;
 183 var
 184         i: Integer;
 185     ResData: PResDataRec;
 186 begin
 187         for i := 0 to FResList.Count - 1 do begin
 188         ResData := FResList[i];
 189                 Dispose(ResData);
 190     end;
 191         FResList.Clear;
 192         FTitle := '';
 193         Caption := '';
 194 end;
 195
 196 function TResPopup.ResCount: Integer;
 197 begin
 198         Result := FResList.Count;
 199 end;
 200
 201 end.