cmpdialogbox.pas

學習資料網上下載

 |                                                                      |
 | Convert a rect from pixels to dialog units.                          |
 *----------------------------------------------------------------------*)
function TDialogBox.RectToDialogRect(r: TRect): TRect;
begin
  if fBaseUnitX = 0 then
    result := r
  else
  begin
    result.Left := Round (r.Left * 4 / fBaseUnitX);
    result.Top := Round (r.Top * 8 / fBaseUnitY);
    result.Right := Round (r.Right * 4 / fBaseUnitX);
    result.Bottom := Round (r.Bottom * 8 / fBaseUnitY)
  end
end;

(*----------------------------------------------------------------------*
 | TDialogBox.SetBounds                                                 |
 |                                                                      |
 | TDialogBox has moved.  Move the dialog too.                          |
 *----------------------------------------------------------------------*)
procedure TDialogBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if fHWndDlg <> 0 then
    SetWindowPos (fhWndDlg, 0, Margin, Margin, AWidth, AHeight, SWP_NOZORDER);

  inherited;
end;

(*----------------------------------------------------------------------*
 | TDialogBox.SetCtrlImage                                              |
 |                                                                      |
 | Set a static or button control's image.                              |
 *----------------------------------------------------------------------*)
procedure TDialogBox.SetCtrlImage(hwndCtrl: HWND; isBtn: Boolean;
  tp: Integer; Handle: HGDIOBJ);
begin
  if Handle = 0 then
    if tp = IMAGE_ICON then
      Handle := LoadIcon (0, IDI_WINLOGO)
    else
      Handle := LoadBitmap (HInstance, 'PREVIEW');

  if isBtn then
    SendMessage (hwndCtrl, BM_SETIMAGE, tp, Handle)
  else
    SendMessage (hwndCtrl, STM_SETIMAGE, tp, Handle)
end;

(*----------------------------------------------------------------------*
 | TDialogBox.SetResourceTemplate                                       |
 |                                                                      |
 | Change the resource template.  Remove the old dialog (if any), and   |
 | show the new one instead.                                            |
 *----------------------------------------------------------------------*)
procedure TDialogBox.SetCtrlImage1(hwndCtrl: HWND; isBtn: Boolean;
  tp: Integer; id : TszOrID);
var
  gdiObj : HGDIOBJ;
  szId : string;
  pszId : PChar;
begin
  if tp <> -1 then
  begin
    gdiobj := 0;
    if Assigned (OnGetControlImage) then
    begin
      if id.isID then
        szId := IntToStr (id.id)
      else
        szId := id.sz;
      OnGetControlImage (Self, tp, szId, gdiobj)
    end
    else
    begin
      if id.isID then
        pszId := PChar (id.id)
      else
        pszId := PChar (id.sz);

      gdiobj := LoadImage (hInstance, pszId, tp, 0, 0, 0);
    end;

    SetCtrlImage (hwndCtrl, isBtn, tp, gdiObj)
  end
end;

procedure TDialogBox.SetResourceTemplate(const Value: pointer);
var
  s : TMemoryStream;

  //-------------------------------------------------------------------------
  // Create a extended resource template from the original one, but with the
  // appropriate style, no menu, etc.

  function CreateAdjustedResourceTemplate : TMemoryStream;
  var
    Template : PDlgTemplate;
    ExTemplate : PDlgTemplateEx;
    newTemplate : TDlgTemplateEx;
    p : PChar;
    szOrId : TSzOrId;
    w : Word;
    b : Byte;
    i : Integer;
    newItemTemplate : TDlgItemTemplateEx;
    ItemTemplate : PDlgItemTemplate;
    ExItemTemplate : PDlgItemTemplateEx;

  begin
    Result := TMemoryStream.Create;
    try
      Template := PDlgTemplate (fResourceTemplate);
      if HiWord (Template^.Style) = $ffff then
      begin
        fExtendedTemplate := True;
        ExTemplate := PDlgTemplateEx (fResourceTemplate);
        fOrigStyle := ExTemplate^.Style;
        fOrigX := ExTemplate^.x;
        fOrigY := ExTemplate^.y;

        newTemplate := ExTemplate^;
        newTemplate.style := (ExTemplate^.style and not (WS_POPUP or DS_CENTER or DS_CENTERMOUSE or DS_ABSALIGN)) or WS_CHILD or WS_VISIBLE;
        newTemplate.x := 0;
        newTemplate.y := 0;
        p := PChar (fResourceTemplate) + SizeOf (TDlgTemplateEx);
      end
      else
      begin
        fExtendedTemplate := False;
        fOrigStyle := Template^.Style;
        fOrigX := Template^.x;
        fOrigY := Template^.y;

        newTemplate.dlgVer := 1;
        newTemplate.signature := $ffff;
        newTemplate.helpID := 0;
        newTemplate.exStyle := Template^.dwExtendedStyle;
        newTemplate.Style := (Template^.Style and not (WS_POPUP or DS_CENTER or DS_CENTERMOUSE or DS_ABSALIGN)) or WS_CHILD or WS_VISIBLE;
        newTemplate.cDlgItems := Template^.cdit;
        newTemplate.x := 0;
        newTemplate.y := 0;
        newTemplate.cx := Template^.cx;
        newTemplate.cy := Template^.cy;
        p := PChar (fResourceTemplate) + SizeOf (TDlgTemplate);
      end;

      Result.Write (newTemplate, SizeOf (newTemplate));

      GetSzOrID (p, szOrId);      // menu
      szOrId.isID := False;         // Get rid of the menu!
      szOrID.sz := '';
      WriteSzOrId (Result, szOrId);

      GetSzOrID (p, szOrID);      // class
      WriteSzOrID (Result, szOrID);
      GetSzOrID (p, szOrID);      // title
      WriteSzOrID (Result, szOrID);

      if (fOrigStyle and DS_SETFONT) <> 0 then
      begin
                                  // Font point
        Result.Write (PWord (p)^, SizeOf (Word));
        Inc (p, SizeOf (Word));

        if fExtendedTemplate then
        begin
          Result.Write (PWord (p)^, SizeOf (Word));
          Inc (p, SizeOf (Word)); // Font weight

          Result.Write (PByte (p)^, SizeOf (Byte));
          Inc (p, SizeOf (Byte)); // Font italic

          Result.Write (PByte (p)^, SizeOf (Byte));
          Inc (p, SizeOf (Byte)); // Font charset
        end
        else
        begin
          w := FW_NORMAL;
          Result.Write (w, SizeOf (w));

          b := 0;
          Result.Write (b, SizeOf (b));

          b := ANSI_CHARSET;
          Result.Write (b, SizeOf (b))
        end;

        GetSzOrID (p, szOrID);
        WriteSzOrID (Result, szOrID);
      end;

      for i := 0 to newTemplate.cDlgItems - 1 do
      begin
        pad (Result);

        p := PChar ((Integer (p) + 3) div 4 * 4);  // Align on DWORD

        if ExtendedTemplate then
        begin
          ExItemTemplate := PDlgItemTemplateEx (p);
          Inc (p, SizeOf (TDlgItemTemplateEx));
          p := PChar ((Integer (p) + 3) div 4 * 4);  // Align on DWORD

          newItemTemplate := ExItemTemplate^;
        end
        else
        begin
          ItemTemplate := PDlgITemTemplate (p);
          Inc (p, SizeOf (TDlgItemTemplate));

          newItemTemplate.helpID := 0;
          newItemTemplate.exStyle := ItemTemplate^.dwExtendedStyle;
          newItemTemplate.Style := ITemTemplate^.Style;
          newItemTemplate.x := ItemTemplate^.x;
          newItemTemplate.y := ItemTemplate^.y;
          newItemTemplate.cx := ItemTemplate^.cx;
          newItemTemplate.cy := ItemTemplate^.cy;
          newItemTemplate.id := ItemTemplate^.id
        end;

        Result.Write (newItemTemplate, SizeOf (newItemTemplate));
        pad (Result);

        GetSzOrID (p, szOrID);          // Class
        WriteSzOrID (Result, szOrID);

        GetSzOrID (p, szOrID);          // Title;
        WriteSzOrID (Result, szOrID);

        w := PWord (p)^;
        Inc (p, SizeOf (Word));
        Result.Write (w, SizeOf (w));

        if w > 0 then
        begin
          Result.Write (p^, w);
          Inc (p, w)
        end
      end
    except
      result.Free;
      raise
    end
  end;

begin { SetResourceTemplate }

  if fHWndDlg <> 0 then                 // Get rid of the old dialog (if any)
    SendMessage (fHWndDlg, WM_CLOSE, 0, 0);

  fResourceTemplate := value;

  if Assigned (fResourceTemplate) then
  begin
    s := CreateAdjustedResourceTemplate;
    try
                                        // Create the dialog window.

      if CreateDialogIndirectParam (hInstance, PDlgTemplate (s.Memory)^, handle, @DialogProc, LPARAM (self)) = 0 then
        RaiseLastOSError;
    finally
      s.Free
    end;

    if fHWndDlg <> 0 then               // Initialize and display the dialog.
    begin
      Parent.Invalidate;
      InitDialogControls;
      ShowWindow (fHwndDlg, SW_SHOW);
      Realign;
      Resize;
      Invalidate;
      if Assigned (fOnShow) then
        fOnShow (Self);
    end
  end
end;

(*----------------------------------------------------------------------*
 | TDialogBox.WmDestroy                                                 |
 |                                                                      |
 | TDialogBox has been destroyed.  Destroy the dialog too.              |
 *----------------------------------------------------------------------*)
procedure TDialogBox.WmDestroy(var msg: TwmDestroy);
begin
  if fHWndDlg <> 0 then
    SendMessage (fHWndDlg, WM_CLOSE, 0, 0);
  inherited;
end;

//---------------------------------------------------------------------
// Create an atom for thunking from dialog handle to TDialogBox, using
// SetProp / GetProp.

var icc : TInitCommonControlsEx;
const
  RichEditModuleName = 'RICHED32.DLL';
initialization
  icc.dwSize := SizeOf (icc);
  icc.dwICC := ICC_INTERNET_CLASSES or ICC_USEREX_CLASSES or ICC_DATE_CLASSES;
  InitCommonControlsEx (icc);

  FRichEditModule := LoadLibrary(RichEditModuleName);
  if FRichEditModule <= HINSTANCE_ERROR then FRichEditModule := 0;

  gWndAtom := GlobalAddAtom ('DlgBox');
finalization
  FreeLibrary (FRichEditModule);
  GlobalDeleteAtom (gWndAtom);
end.