cmpdialogbox.pas

學習資料網上下載

function TDialogBox.DialogPointToPoint(pt: TPoint): TPoint;
begin
  if fBaseUnitX = 0 then
    result := pt
  else
  begin
    result.x := Round (pt.x * fBaseUnitX / 4);
    result.y := Round (pt.y * fBaseUnitY / 8)
  end
end;

(*----------------------------------------------------------------------*
 | TDialogBox.DialogRectToRect                                          |
 |                                                                      |
 | Convert a rect from dialog units to pixels.                          |
 *----------------------------------------------------------------------*)
function TDialogBox.DialogRectToRect(r: TRect): TRect;
begin
  MapDialogRect (DialogHandle, r);
  result := r;
end;


(*----------------------------------------------------------------------*
 | TDialogBox.HandleDlgMessage                                          |
 |                                                                      |
 | HAndle dialog messages.                                              |
 *----------------------------------------------------------------------*)
procedure TDialogBox.GetImageType(const ctrlClass : TSZOrID; Style : DWORD; var isBtn: Boolean; var tp: Integer);
begin
  isBtn := False;
  tp := -1;

  if ctrlClass.id = BUTTON_ID then
  begin
    isBtn := True;
    if (Style and BS_ICON) <> 0 then
      tp := IMAGE_ICON
    else
      if (Style and BS_BITMAP) <> 0 then
        tp := IMAGE_BITMAP
  end
  else
    if ctrlClass.id = STATIC_ID then
    case Style and SS_TYPEMASK of
      SS_ICON : tp := IMAGE_ICON;
      SS_BITMAP : tp := IMAGE_BITMAP;
      SS_ENHMETAFILE : tp := IMAGE_ENHMETAFILE
    end;
end;

procedure TDialogBox.HandleDlgMessage(var Msg: TMessage);
var
  p : PWindowPos;
  continueProcessing : boolean;
  r : TRect;

  procedure GetFontBaseUnits (var baseX, baseY : Double);
  var
    r : TRect;
  begin
    r := Rect (0, 0, 4, 8);
    MapDialogRect (fHWNDDlg, r);
    baseX := r.Right;
    baseY := r.Bottom;
  end;

begin
  ContinueProcessing := True;
  if Assigned (fOnDlgMessage) and not (csDestroying in ComponentState) then
  begin
    msg.result := Ord (False);
    OnDlgMessage (self, msg, ContinueProcessing)
  end;

  if continueProcessing then
  begin
    msg.result := Ord (True);
    case msg.Msg of
      WM_INITDIALOG :
        begin           // Set the control bounds to the size of the dialog box
          fInitializing := True;
          try
            GetWindowRect (fHwndDlg, r);
            MapWindowPoints (HWND_DESKTOP, Parent.Handle, r, 2);
            with r do SetBounds (Self.Left, self.Top, right - left, bottom - top);
            GetFontBaseUnits (fBaseUnitX, fBaseUnitY)
          finally
            fInitializing := False
          end
        end;

      WM_SETFONT :      // Save the font so we can use it for (eg) newly created
                        // controls
        begin
          fHFontDlg := Msg.wParam;
          Msg.Result := Ord (False)
        end;

      WM_CLOSE :        // Close clicked (etc.)  Destroy the dialog
        DestroyWindow (fHwndDlg);

                        // Activate the dialog if it's clicked
      WM_LBUTTONDOWN,
      WM_RBUTTONDOWN,
      WM_NCLBUTTONDOWN,
      WM_NCRBUTTONDOWN :
        begin
          BringWindowToTop (Handle);
          SetActiveWindow (Handle);
          msg.result := Ord (False)
        end;

                        // Don't allow moving the dialog
      WM_WINDOWPOSCHANGING :
      begin
        if not fInitializing then
        begin
          p := PWindowPos (msg.LParam);
          p.Flags := p.Flags or SWP_NOMOVE
        end
      end;

      else
        msg.result := Ord (FALSE);
    end
  end
end;


(*----------------------------------------------------------------------*
 | TDialogBox.InitCtrl                                                  |
 |                                                                      |
 | Called for each control.  Override it to cache control info.         |
 *----------------------------------------------------------------------*)
procedure TDialogBox.InitCtrl(n : Integer; template: Pointer; extraCount : Integer; extraData : PChar; titleSzOrID : TSzOrID);
begin
// stub
end;

(*----------------------------------------------------------------------*
 | TDialogBox.InitDialogControls                                        |
 |                                                                      |
 | Call InitDlg to cache dialog settings, then call InitCtrl for each   |
 | control.  Also set control images, etc.                              |
 *----------------------------------------------------------------------*)
procedure TDialogBox.InitDialogControls;
type
  pbytebool = ^ByteBool;
var
  Template : PDlgTemplate;
  ItemTemplate : PdlgItemTemplate;
  ExTemplate : PDlgTemplateEx;
  ExItemTemplate : PDlgItemTemplateEx;
  p : PChar;
  tempSzOrID, dlgMenu, ctrlClass, ctrlTitle : TSzOrID;
  i, ctrlCount, Style, id, fontPoint, fontWeight, fontCharset : Integer;
  fontItalic : Boolean;
  extraCount : Word;
  tp : Integer;
  gdiobj : HGDIOBJ;
  szId, fontName : string;
  isBtn : Boolean;
begin
  Template := PDlgTemplate (fResourceTemplate);
  p := PChar (fResourceTemplate);
  if ExtendedTemplate then
  begin
    ExTemplate := PDlgTemplateEx (fResourceTemplate);
    Inc (p, SizeOf (TDlgTemplateEx));
    ctrlCount := ExTemplate^.cDlgItems;
    Style := ExTemplate^.Style;
  end
  else
  begin
    ExTemplate := nil;
    Inc (p, SizeOf (TDlgTemplate));
    ctrlCount := Template^.cdit;
    Style := Template^.style
  end;

  GetSzOrID (p, dlgMenu);  // menu
  GetSzOrID (p, ctrlClass);  // class
  GetSzOrID (p, tempSzOrID);  // title

  fontName := '';
  fontCharset := ANSI_CHARSET;
  fontPoint := 8;
  fontWeight := FW_NORMAL;
  fontItalic := False;

  if (Style and DS_SETFONT) <> 0 then
  begin
    fontPoint := PWORD (p)^;
    Inc (p, SizeOf (Word));     // pointsize

    if ExtendedTemplate then
    begin
      fontWeight := PWORD (p)^;
      Inc (p, SizeOf (Word));   // weight

      fontItalic := PBYTEBOOL (p)^;
      Inc (p);                  // italic

      fontCharset := PBYTE (p)^;
      Inc (p);                  // Italic
    end;

    GetSzOrId (p, tempSzOrID);   // Typeface
    fontName := tempSzOrID.sz;
  end;

  if ExtendedTemplate then
    InitDlg (ExTemplate, fontName, fontPoint, fontWeight, fontCharset, fontItalic, dlgMenu, ctrlClass)
  else
    InitDlg (Template, fontName, fontPoint, fontWeight, fontCharset, fontItalic, dlgMenu, ctrlClass);

  if Assigned (OnGetControlImage) and (not dlgMenu.isID or (dlgMenu.id > 0)) then
  begin
    if dlgMenu.isID then
      szId := IntToStr (dlgMenu.id)
    else
      szId := dlgMenu.sz;

    gdiObj := 0;
    OnGetControlImage (Self, -1, szId, gdiobj);
    FreeAndNil (fMenu);
    fMenu := TMenuItem (gdiObj);
  end;

  for i := 0 to ctrlCount - 1 do
  begin
    p := PChar ((Integer (p) + 3) div 4 * 4);  // Align on DWORD

    if ExtendedTemplate then
    begin
      ExItemTemplate := PDlgItemTemplateEx (p);
      ItemTemplate := nil;
      Inc (p, SizeOf (TDlgItemTemplateEx));
      p := PChar ((Integer (p) + 3) div 4 * 4);  // Align on DWORD
      Style := ExItemTemplate^.Style;
      id := ExItemTemplate^.id
    end
    else
    begin
      ItemTemplate := PDlgITemTemplate (p);
      ExItemTemplate := nil;
      Inc (p, SizeOf (TDlgItemTemplate));
      Style := ItemTemplate^.Style;
      id := ItemTemplate^.id
    end;

    GetSzOrID (p, ctrlClass);     // control class
    GetSzOrID (p, ctrlTitle);     // title

    extraCount := PWord (p)^;
    Inc (p, SizeOf (Word));

    Inc (p, extraCount);

    GetImageType (ctrlClass, Style, isBtn, tp);

    if tp <> -1 then
      SetCtrlImage1 (GetDlgItem (fHWndDlg, id), isBtn, tp, ctrlTitle);

    if ExtendedTemplate then
      InitCtrl (i, ExItemTemplate, extraCount, p, ctrlTitle)
    else
      InitCtrl (i, ItemTemplate, extraCount, p, ctrlTitle)
  end
end;

procedure TDialogBox.InitDlg(template : Pointer; const fontName : string; fontPoints, fontWeight, fontCharset : Integer; fontItalic : Boolean; const menu, cls : TSzOrID);
begin
// stub
end;

(*----------------------------------------------------------------------*
 | TDialogBox.PaintWindow                                               |
 |                                                                      |
 | If we're designing, draw an edge to show where the dialog box is     |
 | going to go.                                                         |
 *----------------------------------------------------------------------*)
procedure TDialogBox.PaintWindow(DC: HDC);
var
  r : TRect;
begin
  inherited;
  if (csDesigning in ComponentState) then
  begin
    r := ClientRect;
    InflateRect (r, -2, -2);
    DrawEdge (DC, r, EDGE_RAISED, BF_RECT)
  end
end;

(*----------------------------------------------------------------------*
 | TDialogBox.PointToDialogPoint                                        |
 |                                                                      |
 | Convert a point from pixels to dialog units.                         |
 *----------------------------------------------------------------------*)
function TDialogBox.PointToDialogPoint(pt: TPoint): TPoint;
begin
  if fBaseUnitX = 0 then
    result := pt
  else
  begin
    result.x := Round (pt.x * 4 / fBaseUnitX);
    result.y := Round (pt.y * 8 / fBaseUnitY)
  end
end;

(*----------------------------------------------------------------------*
 | TDialogBox.RectToDialogRect                                          |