小编Bil*_*ill的帖子

用于执行FormResize事件的代码

我尝试了许多方法来强制FormResize事件执行而不包括SetWindowPos.使用鼠标调整窗体大小时,以下代码非常有效,但我还需要使用代码手动调用此代码.但我不希望表格以任何方式改变.

procedure TFormMain.FormResize( Sender: TObject );
begin
  dxDockPanelFolders1.Height := dxVertContainerDockSite1.Height div 3;
  dxDockPanelFiles1.Height := dxVertContainerDockSite1.Height div 3;
  dxDockPanelPreview1.Height := dxVertContainerDockSite1.Height div 3;
end;
Run Code Online (Sandbox Code Playgroud)

在搜索网页时,我还没有看到完成此任务.

delphi

3
推荐指数
1
解决办法
1040
查看次数

如何在创建中设置TCustomControl的父级

When we create a component as a custom control and the control is dropped on a panel the control always appears on the form rather than the containing control. How do you set the parent of the custom control in Create so that when the button is dropped on panel the buttons parent is the panel?

TGlassButton = class(TCustomControl)
...
public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
...

constructor TGlassButton.Create(AOwner: TComponent);
  begin
    inherited;  ???????????
    inherited Create(AOwner); ????????????
    Parent …
Run Code Online (Sandbox Code Playgroud)

delphi

3
推荐指数
1
解决办法
3458
查看次数

如何使用GDIPlus进行InvalidateRect

我可以找到所有GDIPlus演示代码而不会失效.那么在TScrollbox上使用带有TImage的MouseMove进行绘制时,如何使GDIPlus API中的矩形无效?

function NormalizeRect ( R: TRect ): TRect;
begin

  // This routine normalizes a rectangle. It makes sure that the Left,Top
  // coords are always above and to the left of the Bottom,Right coords.

  with R do
  begin

    if Left > Right then
      if Top > Bottom then
        Result := Rect ( Right, Bottom, Left, Top )
      else
        Result := Rect ( Right, Top, Left, Bottom )
    else if Top > Bottom then
      Result := Rect ( Left, Bottom, …
Run Code Online (Sandbox Code Playgroud)

delphi gdi+

3
推荐指数
1
解决办法
1513
查看次数

添加IFileDialogCustomize PushButton事件

我可以使用FileSaveDialog1.Dialog.QueryInterface创建一个按钮,如下所示.如何设置和处理OnPushButton点击事件,以便我可以响应按钮点击?

procedure TForm1.FileSaveDialog1Execute(Sender: TObject);
const
  dwVisualGroup1ID: DWORD = 1900;
var
  c: IFileDialogCustomize;
  d: IFileDialogControlEvents;
begin
  if FileSaveDialog1.Dialog.QueryInterface(IFileDialogCustomize, c) = S_OK then
  begin
    // Add a Advanced Button
    c.AddPushButton(dwVisualGroup1ID, 'Advanced');
    c.MakeProminent(dwVisualGroup1ID);
    // Setup the PushButton Click event?

  end;
Run Code Online (Sandbox Code Playgroud)

delphi

3
推荐指数
1
解决办法
1245
查看次数

动画椭圆点

LineDDA用来绘制动画选择:

procedure TFormMain.DrawMarchingAnts;
begin
  AMarchingAntsCounter := AMarchingAntsCounterStart;
  // Use LineDDA to draw each of the 4 edges of the rectangle
  LineDDA(AMarchingAntsPointA.X, AMarchingAntsPointA.Y, AMarchingAntsPointB.X, AMarchingAntsPointA.Y,
    @MarchingAnts, LongInt(
    AMarchingAntsCanvas));
  LineDDA(AMarchingAntsPointB.X, AMarchingAntsPointA.Y, AMarchingAntsPointB.X, AMarchingAntsPointB.Y,
    @MarchingAnts, LongInt(
    AMarchingAntsCanvas));
  LineDDA(AMarchingAntsPointB.X, AMarchingAntsPointB.Y, AMarchingAntsPointA.X, AMarchingAntsPointB.Y,
    @MarchingAnts, LongInt(
    AMarchingAntsCanvas));
  LineDDA(AMarchingAntsPointA.X, AMarchingAntsPointB.Y, AMarchingAntsPointA.X, AMarchingAntsPointA.Y,
    @MarchingAnts, LongInt(
    AMarchingAntsCanvas));
  if AMarchingAntsPointB.X > AMarchingAntsPointA.X then
    ARubberbandVisible := True
  else
    ARubberbandVisible := False;
end;
Run Code Online (Sandbox Code Playgroud)

是否有一个功能可以将动画椭圆添加到矩形的角点以获得抓点?

delphi

2
推荐指数
1
解决办法
550
查看次数

如何从后代组件中删除属性

我已经创建了一个TListView后代组件...它完美地运行,但我想知道是否有可能删除后代中我不想要的TListView属性.我不想在对象检查器中显示的属性是LargeImages,RowSelect,ShowColumnHeader,ShowWorkAreas,ViewStyle,OwnerData,OnData和OnDataFind.后代只有一个viewstyle vsIcon.

这是组件的接口部分:

  TImageEnListView = class(TListView)
  private
    FImageList: TImageList;
    FImageIndex: integer;
    FStringList: TStringList;
    FThumbnailWidth: integer;
    FThumbnailHeight: integer;
    FIconVerticalSpacing: integer;
    FIconHorzontalSpacing: integer;
    FFolder: string;
    FShadowedThumbnail: boolean;
    FShowCaptions: boolean;
    FShowTips: boolean;
    FBackgroundWorker: TBackgroundWorker;
    FTaskDialog: TTaskDialog;
    procedure BackgroundWorkerWork(Worker: TBackgroundWorker);
    { Event after threading is complete }
    procedure BackgroundWorkerWorkComplete(Worker: TBackgroundWorker; Cancelled: Boolean);
    { Event for feedback to GUI }
    procedure BackgroundWorkerWorkFeedback(Worker: TBackgroundWorker; FeedbackID,
      FeedbackValue: Integer);
  public
   { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Clears thumbnails, fileList and imageList } …
Run Code Online (Sandbox Code Playgroud)

delphi

2
推荐指数
1
解决办法
3570
查看次数

在Windows 8中显示Windows 7 Windows图片查看器

在Windows 8上,我尝试运行下面显示的代码以显示旧的Windows 7图片查看器,但它返回错误.在Windows 8上,我可以找到C:\ Program Files(x86)\ Windows Photo Viewer\PhotoViewer.dll,但我认为这是较新的Windows 8 metro应用程序.我认为旧的Windows图片浏览器是'c:\ windows\system32\shimgvw.dll.我想用桌面应用程序样式而不是Metro预览图像.

我试过两个,但两个都返回该文件没有与之关联的程序?我搞砸了什么?

var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
ExecuteFile, ParamString, StartInString: string;

ExecuteFile:='c:\windows\system32\shimgvw.dll';
FillChar(SEInfo, SizeOf(SEInfo), 0) ;
SEInfo.cbSize := SizeOf(TShellExecuteInfo);
with SEInfo do begin
  fMask := SEE_MASK_NOCLOSEPROCESS;
  Wnd := Application.Handle;
  lpFile := PChar(ExecuteFile);
  nShow := SW_SHOWNORMAL;
  lpParameters := PChar('ImageView_Fullscreen');
end;
if ShellExecuteEx(@SEInfo) then begin
repeat
   Application.ProcessMessages;
   GetExitCodeProcess(SEInfo.hProcess, ExitCode) ;
 until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
   ShowMessage('Windows Picture Viewer terminated') ;
 end
    else ShowMessage('Error starting Windows Picture Viewer') ;
Run Code Online (Sandbox Code Playgroud)

我之前没有使用过ShellExecuteEx,所以代码的基础来自这里 …

delphi winapi delphi-xe4

2
推荐指数
1
解决办法
1261
查看次数

VCL.Bitmap到FMX.Bitmap

我在网上找到了这段代码,但FMX.Bitmap没有扫描线.有可能以某种方式将VCL.TBitmap复制或绘制到FMX.Bitmap吗?

{$IFDEF MSWINDOWS}
type
  TBitmap = FMX.Types.TBitmap;
  TVclBitmap = Vcl.Graphics.TBitmap;

procedure TakeScreenshot(Dest: FMX.Types.TBitmap);
var
  DC: HDC;
  Size: TPointF;
  VCLBitmap: TVclBitmap;
  Y: Integer;
begin
  VCLBitmap := nil;
  //Size := FMX.Platform.IFMXScreenService.GetScreenSize;
  DC := GetDC(0);
  try
    VCLBitmap := TVclBitmap.Create;
    VCLBitmap.PixelFormat := pf32bit;
    VCLBitmap.SetSize(Trunc(Size.X), Trunc(Size.Y));
    BitBlt(VCLBitmap.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height,
      DC, 0, 0, SRCCOPY);
    Dest.SetSize(VCLBitmap.Width, VCLBitmap.Height);
    { The format of a FMX bitmap and a 32 bit VCL bitmap is the same, so just
      copy the scanlines. - not true- FMX bitmap does not …
Run Code Online (Sandbox Code Playgroud)

delphi firemonkey delphi-xe4

2
推荐指数
1
解决办法
3407
查看次数

使用Delphi 10编译SelectDirectory第三次重载

为什么不编译?看起来很简单,但我不明白......是字符串数组的问题?错误是:

[dcc32 Error] Unit1.pas(94): E2250 There is no overloaded version of 'SelectDirectory' that can be called with these arguments. 
Run Code Online (Sandbox Code Playgroud)

这是代码:

{
function SelectDirectory(const StartDirectory: string; out Directories: TArray<string>; Options: TSelectDirFileDlgOpts = [];
  const Title: string = ''; const FolderNameLabel: string = ''; const OkButtonLabel: string = ''): Boolean; overload;
}

procedure TForm2.Browse1Click(Sender: TObject);
var
  iStartFolder: string;
  iDirectories: Array of string;
  iSelectedFolder: string;
begin
  iStartFolder := DesktopFolder;
  if SelectDirectory(iStartFolder, iDirectories,
    [sdHidePinnedPlaces, sdNoDereferenceLinks, sdForceShowHidden,
    sdAllowMultiselect], 'Select Folder', 'Folder', 'Ok') then
    ShowMessage(iDirectories[0]);
end;
Run Code Online (Sandbox Code Playgroud)

delphi delphi-10-seattle

2
推荐指数
1
解决办法
369
查看次数

获取最小化窗口的句柄?

我可以使用FindWindow按标题获取窗口句柄,但如果窗口最小化,则无法获得窗口句柄.如何获得最小化窗口的句柄?

hWindow := FindWindow(nil, iWindowTitle);
Run Code Online (Sandbox Code Playgroud)

delphi delphi-xe4

1
推荐指数
1
解决办法
437
查看次数

标签 统计

delphi ×10

delphi-xe4 ×3

delphi-10-seattle ×1

firemonkey ×1

gdi+ ×1

winapi ×1