我尝试了许多方法来强制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)
在搜索网页时,我还没有看到完成此任务.
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) 我可以找到所有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) 我可以使用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) 我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)
是否有一个功能可以将动画椭圆添加到矩形的角点以获得抓点?
我已经创建了一个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) 在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,所以代码的基础来自这里 …
我在网上找到了这段代码,但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) 为什么不编译?看起来很简单,但我不明白......是字符串数组的问题?错误是:
[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) 我可以使用FindWindow按标题获取窗口句柄,但如果窗口最小化,则无法获得窗口句柄.如何获得最小化窗口的句柄?
hWindow := FindWindow(nil, iWindowTitle);
Run Code Online (Sandbox Code Playgroud)