⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvdialogs.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    SavePen := SelectObject(DC, Pen);
    for I := 0 to (SizeGripRectSize - 2) div 4 do
    begin
      MoveToEx(DC, R.Right, R.Bottom - (I * 4), nil);
      LineTo(DC, R.Right - (I * 4), R.Bottom);
      MoveToEx(DC, R.Right, R.Bottom - (I * 4) - 1, nil);
      LineTo(DC, R.Right - (I * 4) - 1, R.Bottom);
    end;
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
    Pen := CreatePen(PS_SOLID, 1, ColorToRGB(clWindow));
    SavePen := SelectObject(DC, Pen);
    for I := 0 to (SizeGripRectSize - 2) div 4 do
    begin
      MoveToEx(DC, R.Right, R.Bottom - (I * 4) - 2, nil);
      LineTo(DC, R.Right - (I * 4) - 2, R.Bottom);
    end;
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
    EndPaint(ParentWnd, PS);
  end;

begin
  with Msg do
  begin
    case Msg of
      {      WM_SIZE:
              ParentResize;}
      WM_GETMINMAXINFO:
        with PMinMaxInfo(LParam)^ do
        begin
          ptMinTrackSize.X := FInitialSize.cx;
          ptMinTrackSize.Y := FInitialSize.cy;
        end;
      WM_PAINT:
        PaintSizeGrip;
    end;
    Result := CallWindowProc(FOldParentWndInstance, FParentWnd, Msg, WParam, LParam);
    if Msg = WM_SIZE then
      ParentResize;
  end;
end;

procedure TJvOpenDialog.SetDefBtnCaption(const Value: string);
begin
  if FDefBtnCaption <> Value then
  begin
    FDefBtnCaption := Value;
    if FParentWnd <> 0 then
      UpdateCaptions;
  end;
end;

procedure TJvOpenDialog.SetFilterLabelCaption(const Value: string);
begin
  if FFilterLabelCaption <> Value then
  begin
    FFilterLabelCaption := Value;
    if FParentWnd <> 0 then
      UpdateCaptions;
  end;
end;

procedure TJvOpenDialog.SelectFolder(const FolderName: string);
var
  LastFocus: HWND;
begin
  if ParentWnd = 0 then
    Exit;
  LastFocus := GetFocus;
  SendMessage(ParentWnd, CDM_SETCONTROLTEXT, edt1, LPARAM(PChar(FolderName)));
  SendMessage(GetDlgItem(ParentWnd, btnOk), BM_CLICK, 0, 0);
  SendMessage(ParentWnd, CDM_SETCONTROLTEXT, edt1, 0);
  SetFocus(LastFocus);
end;

function TJvOpenDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
{$IFDEF COMPILER5}
const
  PlacesBar: array [Boolean] of DWORD = (OFN_EX_NOPLACESBAR, 0);
var
  DialogData2000: TOpenFileName2000;
{$ENDIF COMPILER5}
begin
  TOpenFileName(DialogData).hInstance := FindClassHInstance(Self.ClassType);
  FActiveSettingDone := False;
  if IsWin2kOrAbove then
  begin
    if ActiveStyle = asReport then
      InstallW2kFix;
    {$IFDEF COMPILER5}
    FillChar(DialogData2000, SizeOf(DialogData2000), #0);
    DialogData2000.OpenFileName := TOpenFileName(DialogData);
    DialogData2000.OpenFileName.lStructSize := SizeOf(DialogData2000);
    DialogData2000.FlagsEx := PlacesBar[FShowPlacesBar];
    Result := inherited TaskModalDialog(DialogFunc, DialogData2000);
    {$ELSE}
    Result := inherited TaskModalDialog(DialogFunc, DialogData);
    {$ENDIF COMPILER5}
  end
  else
    Result := inherited TaskModalDialog(DialogFunc, DialogData);
  if not Result then
    DoError(CommDlgExtendedError);
end;

procedure TJvOpenDialog.UpdateCaptions;
begin
  if Length(FDefBtnCaption) > 0 then
    SendMessage(ParentWnd, CDM_SETCONTROLTEXT, btnOk, Longint(PChar(DefBtnCaption)));
  if Length(FFilterLabelCaption) > 0 then
    SendMessage(ParentWnd, CDM_SETCONTROLTEXT, stc2, Longint(PChar(FilterLabelCaption)));
end;

procedure TJvOpenDialog.UpdateControlPos;
var
  WRect: TRect;
  CtrlWnd: HWND;
  OfsSize: TPoint;
  CLeft, CTop, CWidth, CHeight: Integer;
  DeferHandle: HDWP;

  function GetDlgWndInfo(Wnd: HWND): Boolean;
  var
    Rect: TRect;
  begin
    Result := Wnd <> 0;
    if not Result then
      Exit;
    CtrlWnd := Wnd;
    GetWindowRect(CtrlWnd, Rect);
    MapWindowPoints(0, ParentWnd, Rect, 2);
    CLeft := Rect.Left;
    CTop := Rect.Top;
    CWidth := Rect.Right - Rect.Left;
    CHeight := Rect.Bottom - Rect.Top;
  end;

  function GetDlgItemInfo(ItemNum: Integer): Boolean;
  begin
    Result := GetDlgWndInfo(GetDlgItem(ParentWnd, ItemNum));
  end;

begin
  GetClientRect(ParentWnd, WRect);
  OfsSize.X := (WRect.Right - WRect.Left) - (FOriginalRect.Right - FOriginalRect.Left);
  OfsSize.Y := (WRect.Bottom - WRect.Top) - (FOriginalRect.Bottom - FOriginalRect.Top);
  FOriginalRect := WRect;

  DeferHandle := BeginDeferWindowPos(12);

  GetDlgItemInfo(btnOk); // Default Button
  Inc(CLeft, OfsSize.X);
  Inc(CTop, OfsSize.Y);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(btnCancel); // Cancel Button
  Inc(CLeft, OfsSize.X);
  Inc(CTop, OfsSize.Y);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(pshHelp); // Help Button
  Inc(CLeft, OfsSize.X);
  Inc(CTop, OfsSize.Y);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(edt1); // Filename
  Inc(CTop, OfsSize.Y);
  Inc(CWidth, OfsSize.X);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, CWidth, CHeight,
    SWP_NOACTIVATE or SWP_NOZORDER);

  GetDlgItemInfo(cmb1); // File Type
  Inc(CTop, OfsSize.Y);
  Inc(CWidth, OfsSize.X);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, CWidth, CHeight,
    SWP_NOACTIVATE or SWP_NOZORDER);

  GetDlgItemInfo(chx1); // Read-only Checkbox
  Inc(CTop, OfsSize.Y);
  Inc(CWidth, OfsSize.X);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, CWidth, CHeight,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(stc2); // File Type Label
  Inc(CTop, OfsSize.Y);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(stc3); // Filename Label
  Inc(CTop, OfsSize.Y);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);

  GetDlgItemInfo(cmb2); // Folder combobox
  Inc(CWidth, OfsSize.X);
  DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, 0, 0, CWidth, CHeight,
    SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE);

  if GetDlgItemInfo(lst2) then // ListView run
  begin
    Inc(CHeight, OfsSize.Y);
    Inc(CWidth, OfsSize.X);
    DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, 0, 0, CWidth, CHeight,
      SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE);
  end;
  if GetDlgItemInfo(lst1) then // ListView init
  begin
    Inc(CHeight, OfsSize.Y);
    Inc(CWidth, OfsSize.X);
    DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, 0, 0, CWidth, CHeight,
      SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE);
  end;

  if GetDlgWndInfo(FindWindowEx(FParentWnd, 0, TOOLBARCLASSNAME, nil)) then
  begin
    Inc(CLeft, OfsSize.X);
    DeferHandle := DeferWindowPos(DeferHandle, CtrlWnd, 0, CLeft, CTop, 0, 0,
      SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOSIZE);
  end;

  EndDeferWindowPos(DeferHandle);
end;

procedure TJvOpenDialog.WMNCDestroy(var Msg: TWMNCDestroy);
begin
  FParentWnd := 0;
  inherited;
end;

procedure TJvOpenDialog.WndProc(var Msg: TMessage);
const
  ShareViolResult: array [Boolean] of DWORD = (OFN_SHARENOWARN, OFN_SHAREFALLTHROUGH);
begin
  with Msg do
    case Msg of
      WM_ENTERIDLE:
        DoActiveSetting;
      WM_NOTIFY:
        case POFNotify(LParam)^.hdr.code of
          CDN_SHAREVIOLATION:
            if Assigned(FOnShareViolation) then
            begin
              Result := ShareViolResult[DoShareViolation];
              SetWindowLong(Handle, DWL_MSGRESULT, Result);
              Exit;
            end;
        end;
    end;
  inherited;
end;

procedure TJvOpenDialog.DoError(ErrorCode: Cardinal);
begin
  if Assigned(FOnError) then
    FOnError(Self, ErrorCode);
end;

//=== { TJvSaveDialog } ======================================================

function TJvSaveDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
  DialogFunc := @GetSaveFileName;
  Result := inherited TaskModalDialog(DialogFunc, DialogData);
end;

//=== { TJvColorDialog } =====================================================

var
  GlobalColorDialog: TJvColorDialog = nil;
  OldColorDialogHookProc: Pointer = nil;

function ColorDialogHook(Wnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UINT; stdcall;
begin
  if Assigned(GlobalColorDialog) and (Msg = GlobalColorDialog.FColorOkMessage) then
    Result := Integer(not GlobalColorDialog.DoQueryColor(TColor(PChooseColor(LParam)^.rgbResult)))
  else
    Result := CallWindowProc(OldColorDialogHookProc, Wnd, Msg, WParam, LParam);
end;

constructor TJvColorDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FColorOkMessage := RegisterWindowMessage(COLOROKSTRING);
  FSetRBGMessage := RegisterWindowMessage(SETRGBSTRING);
end;

procedure TJvColorDialog.DoClose;
begin
  GlobalColorDialog := nil;
  inherited DoClose;
end;

function TJvColorDialog.DoQueryColor(Color: TColor): Boolean;
begin
  Result := True;
  if Assigned(FOnQueryColor) then
    FOnQueryColor(Self, Color, Result);
end;

procedure TJvColorDialog.DoShow;
begin
  GlobalColorDialog := Self;
  inherited DoShow;
end;

procedure TJvColorDialog.SelectColor(Color: TColor);
begin
  if Handle <> 0 then
    SendMessage(Handle, FSetRBGMessage, 0, ColorToRGB(Color));
end;

function TJvColorDialog.TaskModalDialog(DialogFunc: Pointer; var DialogData): Bool;
begin
  with TChooseColor(DialogData) do
  begin
    OldColorDialogHookProc := @lpfnHook;
    lpfnHook := ColorDialogHook;
  end;
  Result := inherited TaskModalDialog(DialogFunc, DialogData);
end;

procedure TJvColorDialog.WMNCDestroy(var Msg: TWMNCDestroy);
begin
  inherited;
  OldColorDialogHookProc := nil;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}

finalization
  UninstallW2kFix;
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -