mirror of
https://github.com/ngeor/Chameleon.git
synced 2025-12-19 09:53:43 +01:00
Add 'pas/' from commit '71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c'
git-subtree-dir: pas git-subtree-mainline: 6d5784cc4089eeb4864244cd4951b1aa66b4e90e git-subtree-split: 71642f0773f3b21b1e6bcdfcfdbdb186b6c8f78c
This commit is contained in:
Nikolaos Georgiou
commit
a5cf23eda4
87
Chameleon.dof
Normal file
87
Chameleon.dof
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
[FileVersion]
|
||||||
|
Version=6.0
|
||||||
|
[Compiler]
|
||||||
|
A=8
|
||||||
|
B=0
|
||||||
|
C=1
|
||||||
|
D=1
|
||||||
|
E=0
|
||||||
|
F=0
|
||||||
|
G=1
|
||||||
|
H=1
|
||||||
|
I=1
|
||||||
|
J=0
|
||||||
|
K=0
|
||||||
|
L=1
|
||||||
|
M=0
|
||||||
|
N=1
|
||||||
|
O=1
|
||||||
|
P=1
|
||||||
|
Q=0
|
||||||
|
R=0
|
||||||
|
S=0
|
||||||
|
T=0
|
||||||
|
U=0
|
||||||
|
V=1
|
||||||
|
W=0
|
||||||
|
X=1
|
||||||
|
Y=1
|
||||||
|
Z=1
|
||||||
|
ShowHints=1
|
||||||
|
ShowWarnings=1
|
||||||
|
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
|
||||||
|
[Linker]
|
||||||
|
MapFile=0
|
||||||
|
OutputObjs=0
|
||||||
|
ConsoleApp=1
|
||||||
|
DebugInfo=0
|
||||||
|
RemoteSymbols=0
|
||||||
|
MinStackSize=16384
|
||||||
|
MaxStackSize=1048576
|
||||||
|
ImageBase=4194304
|
||||||
|
ExeDescription=
|
||||||
|
[Directories]
|
||||||
|
OutputDir=
|
||||||
|
UnitOutputDir=
|
||||||
|
PackageDLLOutputDir=
|
||||||
|
PackageDCPOutputDir=
|
||||||
|
SearchPath=
|
||||||
|
Packages=
|
||||||
|
Conditionals=
|
||||||
|
DebugSourceDirs=
|
||||||
|
UsePackages=0
|
||||||
|
[Parameters]
|
||||||
|
RunParams=
|
||||||
|
HostApplication=
|
||||||
|
Launcher=
|
||||||
|
UseLauncher=0
|
||||||
|
DebugCWD=
|
||||||
|
[Language]
|
||||||
|
ActiveLang=
|
||||||
|
ProjectLang=
|
||||||
|
RootDir=
|
||||||
|
[Version Info]
|
||||||
|
IncludeVerInfo=1
|
||||||
|
AutoIncBuild=0
|
||||||
|
MajorVer=1
|
||||||
|
MinorVer=0
|
||||||
|
Release=0
|
||||||
|
Build=0
|
||||||
|
Debug=0
|
||||||
|
PreRelease=0
|
||||||
|
Special=0
|
||||||
|
Private=0
|
||||||
|
DLL=0
|
||||||
|
Locale=1033
|
||||||
|
CodePage=1252
|
||||||
|
[Version Info Keys]
|
||||||
|
CompanyName=
|
||||||
|
FileDescription=
|
||||||
|
FileVersion=1.0.0.0
|
||||||
|
InternalName=
|
||||||
|
LegalCopyright=
|
||||||
|
LegalTrademarks=
|
||||||
|
OriginalFilename=
|
||||||
|
ProductName=
|
||||||
|
ProductVersion=1.0.0.0
|
||||||
|
Comments=
|
||||||
116
Chameleon.lpi
Normal file
116
Chameleon.lpi
Normal file
@ -0,0 +1,116 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="Chameleon"/>
|
||||||
|
<UseAppBundle Value="False"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<XPManifest>
|
||||||
|
<DpiAware Value="True"/>
|
||||||
|
</XPManifest>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="7">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="Chameleon.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="frmMain.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="MainForm"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="frmResults.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Results"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="Writers.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="DfmEngine.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="StrConsts.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="about1.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="AboutBox"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
</Unit6>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Parsing>
|
||||||
|
<SyntaxOptions>
|
||||||
|
<SyntaxMode Value="Delphi"/>
|
||||||
|
</SyntaxOptions>
|
||||||
|
</Parsing>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
24
Chameleon.lpr
Normal file
24
Chameleon.lpr
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
program Chameleon;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Forms,
|
||||||
|
Interfaces,
|
||||||
|
frmMain in 'frmMain.pas' {MainForm},
|
||||||
|
frmResults in 'frmResults.pas' {Results},
|
||||||
|
Writers in 'Writers.pas',
|
||||||
|
DfmEngine in 'DfmEngine.pas',
|
||||||
|
StrConsts in 'StrConsts.pas',
|
||||||
|
about1 in 'about1.pas' {AboutBox};
|
||||||
|
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.CreateForm(TResults, Results);
|
||||||
|
Application.CreateForm(TAboutBox, AboutBox);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
BIN
Chameleon.res
Normal file
BIN
Chameleon.res
Normal file
Binary file not shown.
444
DfmEngine.pas
Normal file
444
DfmEngine.pas
Normal file
@ -0,0 +1,444 @@
|
|||||||
|
unit DfmEngine;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Windows, Messages, SysUtils, Classes, Forms, Graphics,
|
||||||
|
Writers;
|
||||||
|
|
||||||
|
type
|
||||||
|
PEnumParams = ^TEnumParams;
|
||||||
|
|
||||||
|
TEnumParams = record
|
||||||
|
List: TList;
|
||||||
|
ParentWnd: HWND;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TKnownControl = (
|
||||||
|
kcUnknown, kcButton, kcCheckBox, kcComboBox, kcEdit,
|
||||||
|
kcGroupBox, kcImage, kcLabel, kcListBox, kcListView,
|
||||||
|
kcPanel, kcRadioButton, kcStatusBar, kcTreeView
|
||||||
|
);
|
||||||
|
TKnownControls = set of TKnownControl;
|
||||||
|
TKnownControlHandlerProc = procedure(wnd: HWND; style: integer) of object;
|
||||||
|
|
||||||
|
TDfmBuilder = class
|
||||||
|
private
|
||||||
|
PasList: TStrings;
|
||||||
|
dfm1: TDfmWriter;
|
||||||
|
Counts: array[TKnownControl] of integer;
|
||||||
|
CtlType: TKnownControl;
|
||||||
|
procedure DispatchHandle(wnd: HWND; style: integer);
|
||||||
|
procedure HandleUnknown(wnd: HWND; style: integer);
|
||||||
|
procedure HandleButton(wnd: HWND; style: integer);
|
||||||
|
procedure HandleCheckBox(wnd: HWND; style: integer);
|
||||||
|
procedure HandleComboBox(wnd: HWND; style: integer);
|
||||||
|
procedure HandleEdit(wnd: HWND; style: integer);
|
||||||
|
procedure HandleGroupBox(wnd: HWND; style: integer);
|
||||||
|
procedure HandleImage(wnd: HWND; style: integer);
|
||||||
|
procedure HandleLabel(wnd: HWND; style: integer);
|
||||||
|
procedure HandleListBox(wnd: HWND; style: integer);
|
||||||
|
procedure HandleListView(wnd: HWND; style: integer);
|
||||||
|
procedure HandlePanel(wnd: HWND; style: integer);
|
||||||
|
procedure HandleRadioButton(wnd: HWND; style: integer);
|
||||||
|
procedure HandleStatusBar(wnd: HWND; style: integer);
|
||||||
|
procedure HandleTreeView(wnd: HWND; style: integer);
|
||||||
|
procedure PreHandleCtl(wnd: HWND);
|
||||||
|
procedure WriteDecl;
|
||||||
|
public
|
||||||
|
constructor Create(APasList: TStrings);
|
||||||
|
procedure Build(OutStream: TStream; const frmName: string; wnd: HWND);
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
KCNames: array[TKnownControl] of string = (
|
||||||
|
'Unknown', 'Button', 'CheckBox', 'ComboBox', 'Edit',
|
||||||
|
'GroupBox', 'Image', 'Label', 'ListBox', 'ListView',
|
||||||
|
'Panel', 'RadioButton', 'StatusBar', 'TreeView'
|
||||||
|
);
|
||||||
|
|
||||||
|
KCClassNames: array[TKnownControl] of string = (
|
||||||
|
'TPanel', 'TButton', 'TCheckBox', 'TComboBox', 'TEdit',
|
||||||
|
'TGroupBox', 'TImage', 'TLabel', 'TListBox', 'TListView',
|
||||||
|
'TPanel', 'TRadioButton', 'TStatusBar', 'TTreeView'
|
||||||
|
);
|
||||||
|
|
||||||
|
function BitTest(Value, Mask: integer): boolean;
|
||||||
|
function GetWndText(wnd: HWND): string;
|
||||||
|
function EnumChildrenProc(wnd: HWND; lp: LPARAM): BOOL; stdcall;
|
||||||
|
procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP;
|
||||||
|
BelongsToPicture: boolean; const Name: string);
|
||||||
|
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean;
|
||||||
|
const Name: string);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function BitTest(Value, Mask: integer): boolean;
|
||||||
|
begin
|
||||||
|
Result := (Value and Mask) = Mask;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetWndText(wnd: HWND): string;
|
||||||
|
var
|
||||||
|
len: integer;
|
||||||
|
begin
|
||||||
|
len := GetWindowTextLength(wnd);
|
||||||
|
SetLength(Result, len);
|
||||||
|
GetWindowText(wnd, PChar(Result), len + 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EnumChildrenProc(wnd: HWND; lp: LPARAM): BOOL; stdcall;
|
||||||
|
var
|
||||||
|
p: PEnumParams;
|
||||||
|
begin
|
||||||
|
p := PEnumParams(lp);
|
||||||
|
if GetParent(wnd) = p^.ParentWnd then
|
||||||
|
p^.List.Add(Pointer(wnd));
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetBorderIconsStr(ABorderIcons: TBorderIcons): string;
|
||||||
|
const
|
||||||
|
biStr: array [TBorderIcon] of string = (
|
||||||
|
'biSystemMenu', 'biMinimize', 'biMaximize', 'biHelp');
|
||||||
|
var
|
||||||
|
k: TBorderIcon;
|
||||||
|
begin
|
||||||
|
if ABorderIcons = [] then
|
||||||
|
begin
|
||||||
|
Result := '[]';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
Result := '[';
|
||||||
|
for k := biSystemMenu to biHelp do
|
||||||
|
if k in ABorderIcons then
|
||||||
|
Result := Result + biStr[k] + ',';
|
||||||
|
Result[Length(Result)] := ']';
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TDfmBuilder.Create(APasList: TStrings);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
PasList := APasList;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.Build(OutStream: TStream; const frmName: string; wnd: HWND);
|
||||||
|
var
|
||||||
|
InStream: TMemoryStream;
|
||||||
|
childlist: TList;
|
||||||
|
i: integer;
|
||||||
|
style, exstyle: longint;
|
||||||
|
wndX: HWND;
|
||||||
|
EnumParams: TEnumParams;
|
||||||
|
|
||||||
|
procedure WriteBorderIcons;
|
||||||
|
var
|
||||||
|
bi: TBorderIcons;
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
bi := [];
|
||||||
|
if BitTest(style, WS_SYSMENU) then
|
||||||
|
Include(bi, biSystemMenu);
|
||||||
|
if BitTest(style, WS_MINIMIZEBOX) then
|
||||||
|
Include(bi, biMinimize);
|
||||||
|
if BitTest(style, WS_MAXIMIZEBOX) then
|
||||||
|
Include(bi, biMaximize);
|
||||||
|
if BitTest(exstyle, WS_EX_CONTEXTHELP) then
|
||||||
|
Include(bi, biHelp);
|
||||||
|
s := GetBorderIconsStr(bi);
|
||||||
|
dfm1.WriteCustomProp('BorderIcons', s);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
// Initialize
|
||||||
|
FillChar(Counts, sizeof(Counts), #0);
|
||||||
|
InStream := TMemoryStream.Create;
|
||||||
|
Dfm1 := TDfmWriter.Create(InStream);
|
||||||
|
childlist := TList.Create;
|
||||||
|
|
||||||
|
dfm1.WriteLn('object ' + frmName + ': T' + frmName);
|
||||||
|
exstyle := GetWindowLong(wnd, GWL_EXSTYLE);
|
||||||
|
dfm1.Ident := 2;
|
||||||
|
dfm1.WritePlacement(wnd, 0);
|
||||||
|
WriteBorderIcons;
|
||||||
|
dfm1.WriteStringProp('Caption', GetWndText(wnd));
|
||||||
|
dfm1.WriteCustomProp('Font.Charset', 'GREEK_CHARSET');
|
||||||
|
dfm1.WriteColorProp('Font.Color', clWindowText);
|
||||||
|
dfm1.WriteIntProp('Font.Height', -11);
|
||||||
|
dfm1.WriteStringProp('Font.Name', 'MS Sans Serif');
|
||||||
|
dfm1.WriteCustomProp('Font.Style', '[]');
|
||||||
|
WriteIconData(dfm1, SendMessage(wnd, WM_GETICON, 0, 0), False, 'Icon.Data');
|
||||||
|
dfm1.WriteIntProp('PixelsPerInch', 96);
|
||||||
|
dfm1.WriteIntProp('TextHeight', 13);
|
||||||
|
|
||||||
|
// write the children
|
||||||
|
EnumParams.List := childlist;
|
||||||
|
EnumParams.ParentWnd := wnd;
|
||||||
|
EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams));
|
||||||
|
for i := 0 to childlist.Count - 1 do
|
||||||
|
begin
|
||||||
|
wndX := HWND(childlist[i]);
|
||||||
|
PreHandleCtl(wndX);
|
||||||
|
end;
|
||||||
|
dfm1.Ident := 0;
|
||||||
|
dfm1.WriteLn('end');
|
||||||
|
InStream.Position := 0;
|
||||||
|
|
||||||
|
ObjectTextToResource(InStream, OutStream);
|
||||||
|
|
||||||
|
// finalization
|
||||||
|
childlist.Free;
|
||||||
|
DFM1.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleUnknown(wnd: HWND; style: integer);
|
||||||
|
var
|
||||||
|
class_name: array [0..100] of char;
|
||||||
|
childlist: TList;
|
||||||
|
EnumParams: TEnumParams;
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
// since we don't know what window we're after write the class name
|
||||||
|
GetClassName(wnd, class_name, 100);
|
||||||
|
dfm1.WriteStringProp('Caption', class_name);
|
||||||
|
childlist := TList.Create;
|
||||||
|
EnumParams.List := childlist;
|
||||||
|
EnumParams.ParentWnd := wnd;
|
||||||
|
EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams));
|
||||||
|
for i := 0 to childlist.Count - 1 do
|
||||||
|
begin
|
||||||
|
PreHandleCtl(HWND(childlist[i]));
|
||||||
|
end;
|
||||||
|
childlist.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleButton(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
dfm1.WriteStringProp('Caption', GetWndText(wnd));
|
||||||
|
dfm1.WriteBoolProp('Default', BitTest(style, BS_DEFPUSHBUTTON));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleCheckBox(wnd: HWND; style: integer);
|
||||||
|
const
|
||||||
|
CheckedStr: array [0..2] of string = ('cbUnchecked', 'cbChecked', 'cbGrayed');
|
||||||
|
var
|
||||||
|
state: integer;
|
||||||
|
allowgrayed: boolean;
|
||||||
|
begin
|
||||||
|
allowgrayed := BitTest(style, BS_3STATE) or BitTest(style, BS_AUTO3STATE);
|
||||||
|
state := SendMessage(wnd, BM_GETCHECK, 0, 0);
|
||||||
|
dfm1.WriteBoolProp('AllowGrayed', allowgrayed);
|
||||||
|
dfm1.WriteStringProp('Caption', GetWndText(wnd));
|
||||||
|
dfm1.WriteCustomProp('State', CheckedStr[state]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleComboBox(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleEdit(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
dfm1.WriteStringProp('Text', GetWndText(wnd));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleGroupBox(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleImage(wnd: HWND; style: integer);
|
||||||
|
var
|
||||||
|
h: THANDLE;
|
||||||
|
OnlyIcon: boolean;
|
||||||
|
begin
|
||||||
|
OnlyIcon := BitTest(style, SS_ICON);
|
||||||
|
if OnlyIcon then
|
||||||
|
begin
|
||||||
|
h := SendMessage(wnd, STM_GETICON, 0, 0);
|
||||||
|
WriteIconData(dfm1, h, True, 'Picture.Data');
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
h := SendMessage(wnd, STM_GETIMAGE, IMAGE_BITMAP, 0);
|
||||||
|
if h <> 0 then
|
||||||
|
WriteBitmapData(dfm1, h, True, 'Picture.Data')
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
h := SendMessage(wnd, STM_GETIMAGE, IMAGE_ICON, 0);
|
||||||
|
WriteIconData(dfm1, h, True, 'Picture.Data');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleLabel(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
dfm1.WriteBoolProp('AutoSize', False);
|
||||||
|
dfm1.WriteStringProp('Caption', GetWndText(wnd));
|
||||||
|
dfm1.WriteBoolProp('WordWrap', True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleListBox(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleListView(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandlePanel(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleRadioButton(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleStatusBar(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.HandleTreeView(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP;
|
||||||
|
BelongsToPicture: boolean; const Name: string);
|
||||||
|
var
|
||||||
|
b: TBitmap;
|
||||||
|
Memory: TTextWriter;
|
||||||
|
Size, Offset: integer;
|
||||||
|
begin
|
||||||
|
b := TBitmap.Create;
|
||||||
|
Memory := TTextWriter.Create(TMemoryStream.Create);
|
||||||
|
try
|
||||||
|
b.Handle := CopyImage(bmp, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG);
|
||||||
|
|
||||||
|
if BelongsToPicture then
|
||||||
|
Memory.WriteString('TBitmap');
|
||||||
|
size := 0;
|
||||||
|
Offset := Memory.Stream.Position;
|
||||||
|
Memory.Stream.Write(size, SizeOf(size));
|
||||||
|
b.SaveToStream(Memory.Stream);
|
||||||
|
Memory.Stream.Position := Offset;
|
||||||
|
size := Memory.Stream.Size - sizeof(size) - Offset;
|
||||||
|
Memory.Stream.Write(size, SizeOf(size));
|
||||||
|
Memory.Stream.Position := 0;
|
||||||
|
|
||||||
|
dfm1.Write(Name + ' = {');
|
||||||
|
dfm1.Ident := dfm1.Ident + 2;
|
||||||
|
dfm1.WriteBinaryAsText(Memory.Stream);
|
||||||
|
dfm1.Ident := dfm1.Ident - 2;
|
||||||
|
dfm1.WriteLn('}');
|
||||||
|
finally
|
||||||
|
b.Handle := 0;
|
||||||
|
b.Free;
|
||||||
|
Memory.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean;
|
||||||
|
const Name: string);
|
||||||
|
var
|
||||||
|
i: TIcon;
|
||||||
|
k: TTextWriter;
|
||||||
|
begin
|
||||||
|
if icon = 0 then
|
||||||
|
Exit;
|
||||||
|
i := TIcon.Create;
|
||||||
|
k := TTextWriter.Create(TMemoryStream.Create);
|
||||||
|
try
|
||||||
|
i.Handle := CopyIcon(icon);
|
||||||
|
if BelongsToPicture then
|
||||||
|
k.WriteString('TIcon');
|
||||||
|
i.SaveToStream(k.Stream);
|
||||||
|
k.Stream.Position := 0;
|
||||||
|
|
||||||
|
dfm1.Write(Name + ' = {');
|
||||||
|
dfm1.Ident := dfm1.Ident + 2;
|
||||||
|
dfm1.WriteBinaryAsText(k.Stream);
|
||||||
|
dfm1.WriteLn('}');
|
||||||
|
dfm1.Ident := dfm1.Ident - 2;
|
||||||
|
|
||||||
|
finally
|
||||||
|
i.Free;
|
||||||
|
k.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.WriteDecl;
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
Inc(Counts[CtlType]);
|
||||||
|
s := KCNames[CtlType] + IntToStr(Counts[CtlType]) + ': ' + KCClassNames[CtlType];
|
||||||
|
PasList.Add(s + ';');
|
||||||
|
dfm1.WriteLn('object ' + s);
|
||||||
|
dfm1.Ident := dfm1.Ident + 2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.DispatchHandle(wnd: HWND; style: integer);
|
||||||
|
begin
|
||||||
|
case CtlType of
|
||||||
|
kcUnknown: HandleUnknown(wnd, style);
|
||||||
|
kcButton: HandleButton(wnd, style);
|
||||||
|
kcCheckBox: HandleCheckBox(wnd, style);
|
||||||
|
kcComboBox: HandleComboBox(wnd, style);
|
||||||
|
kcEdit: HandleEdit(wnd, style);
|
||||||
|
kcGroupBox: HandleGroupBox(wnd, style);
|
||||||
|
kcImage: HandleImage(wnd, style);
|
||||||
|
kcLabel: HandleLabel(wnd, style);
|
||||||
|
kcListBox: HandleListBox(wnd, style);
|
||||||
|
kcListView: HandleListView(wnd, style);
|
||||||
|
kcPanel: HandlePanel(wnd, style);
|
||||||
|
kcRadioButton: HandleRadioButton(wnd, style);
|
||||||
|
kcStatusBar: HandleStatusBar(wnd, style);
|
||||||
|
kcTreeView: HandleTreeView(wnd, style);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmBuilder.PreHandleCtl(wnd: HWND);
|
||||||
|
var
|
||||||
|
class_name: array [0..100] of char;
|
||||||
|
style: integer;
|
||||||
|
begin
|
||||||
|
GetClassName(wnd, class_name, 100);
|
||||||
|
style := GetWindowLong(wnd, GWL_STYLE);
|
||||||
|
if StrIComp(class_name, 'Static') = 0 then
|
||||||
|
begin
|
||||||
|
if BitTest(style, SS_BITMAP) or BitTest(style, SS_ICON) then
|
||||||
|
CtlType := kcImage
|
||||||
|
else
|
||||||
|
CtlType := kcLabel;
|
||||||
|
end
|
||||||
|
else if StrIComp(class_name, 'Button') = 0 then
|
||||||
|
begin
|
||||||
|
if BitTest(style, BS_GROUPBOX) then
|
||||||
|
CtlType := kcGroupBox
|
||||||
|
else if BitTest(style, BS_RADIOBUTTON) or BitTest(style, BS_AUTORADIOBUTTON) then
|
||||||
|
CtlType := kcRadioButton
|
||||||
|
else if BitTest(style, BS_CHECKBOX) or BitTest(style, BS_AUTOCHECKBOX) or
|
||||||
|
BitTest(style, BS_3STATE) or BitTest(style, BS_AUTO3STATE) then
|
||||||
|
CtlType := kcCheckBox
|
||||||
|
else
|
||||||
|
CtlType := kcButton;
|
||||||
|
end
|
||||||
|
else if StrIComp(class_name, 'ComboBox') = 0 then
|
||||||
|
CtlType := kcComboBox
|
||||||
|
else if StrIComp(class_name, 'ListBox') = 0 then
|
||||||
|
CtlType := kcListBox
|
||||||
|
else if StrIComp(class_name, 'Edit') = 0 then
|
||||||
|
CtlType := kcEdit
|
||||||
|
else if StrIComp(class_name, 'msctls_statusbar32') = 0 then
|
||||||
|
CtlType := kcStatusBar
|
||||||
|
else
|
||||||
|
CtlType := kcUnknown;
|
||||||
|
|
||||||
|
WriteDecl;
|
||||||
|
dfm1.WritePlacement(wnd, GetParent(wnd));
|
||||||
|
DispatchHandle(wnd, style);
|
||||||
|
dfm1.Ident := dfm1.Ident - 2;
|
||||||
|
dfm1.WriteLn('end');
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
2
README.md
Normal file
2
README.md
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
# Chameleon
|
||||||
|
A Delphi app that can replicate any window from any other program and generate a Delphi form that looks identical (legacy project, Windows only)
|
||||||
106
StrConsts.pas
Normal file
106
StrConsts.pas
Normal file
@ -0,0 +1,106 @@
|
|||||||
|
unit StrConsts;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Windows;
|
||||||
|
|
||||||
|
const
|
||||||
|
WindowStyle: array [0..21] of DWORD = (
|
||||||
|
WS_BORDER,
|
||||||
|
WS_CAPTION,
|
||||||
|
WS_CHILD,
|
||||||
|
WS_CLIPCHILDREN,
|
||||||
|
WS_CLIPSIBLINGS,
|
||||||
|
WS_DISABLED,
|
||||||
|
WS_DLGFRAME,
|
||||||
|
WS_GROUP,
|
||||||
|
WS_HSCROLL,
|
||||||
|
WS_MAXIMIZE,
|
||||||
|
WS_MAXIMIZEBOX,
|
||||||
|
WS_MINIMIZE,
|
||||||
|
WS_MINIMIZEBOX,
|
||||||
|
WS_OVERLAPPED,
|
||||||
|
WS_OVERLAPPEDWINDOW,
|
||||||
|
WS_POPUP,
|
||||||
|
WS_POPUPWINDOW,
|
||||||
|
WS_SYSMENU,
|
||||||
|
WS_TABSTOP,
|
||||||
|
WS_THICKFRAME,
|
||||||
|
WS_VISIBLE,
|
||||||
|
WS_VSCROLL);
|
||||||
|
|
||||||
|
WindowStyleName: array [0..21] of string = (
|
||||||
|
'Border',
|
||||||
|
'Caption',
|
||||||
|
'Child',
|
||||||
|
'Clip children',
|
||||||
|
'Clip siblings',
|
||||||
|
'Disabled',
|
||||||
|
'Dialog frame',
|
||||||
|
'Group',
|
||||||
|
'Horizontal scroll bar',
|
||||||
|
'Maximized',
|
||||||
|
'Maximize button',
|
||||||
|
'Minimized',
|
||||||
|
'Minimize button',
|
||||||
|
'Overlapped',
|
||||||
|
'Overlapped window',
|
||||||
|
'Pop-up',
|
||||||
|
'Pop-up window',
|
||||||
|
'System menu',
|
||||||
|
'Tab stop',
|
||||||
|
'Sizing frame',
|
||||||
|
'Visible',
|
||||||
|
'Vertical scroll bar');
|
||||||
|
|
||||||
|
ExtendedWindowStyle: array [0..20] of integer = (
|
||||||
|
WS_EX_ACCEPTFILES,
|
||||||
|
WS_EX_APPWINDOW,
|
||||||
|
WS_EX_CLIENTEDGE,
|
||||||
|
WS_EX_CONTEXTHELP,
|
||||||
|
WS_EX_CONTROLPARENT,
|
||||||
|
WS_EX_DLGMODALFRAME,
|
||||||
|
WS_EX_LEFT,
|
||||||
|
WS_EX_LEFTSCROLLBAR,
|
||||||
|
WS_EX_LTRREADING,
|
||||||
|
WS_EX_MDICHILD,
|
||||||
|
WS_EX_NOPARENTNOTIFY,
|
||||||
|
WS_EX_OVERLAPPEDWINDOW,
|
||||||
|
WS_EX_PALETTEWINDOW,
|
||||||
|
WS_EX_RIGHT,
|
||||||
|
WS_EX_RIGHTSCROLLBAR,
|
||||||
|
WS_EX_RTLREADING,
|
||||||
|
WS_EX_STATICEDGE,
|
||||||
|
WS_EX_TOOLWINDOW,
|
||||||
|
WS_EX_TOPMOST,
|
||||||
|
WS_EX_TRANSPARENT,
|
||||||
|
WS_EX_WINDOWEDGE);
|
||||||
|
|
||||||
|
ExtendedWindowStyleName: array [0..20] of string = (
|
||||||
|
'Drag drop recepient',
|
||||||
|
'Minimize on taskbar',
|
||||||
|
'Sunken edge border',
|
||||||
|
'Context help',
|
||||||
|
'TAB key navigation',
|
||||||
|
'Double border',
|
||||||
|
'Left aligned (default)',
|
||||||
|
'Left vertical scrollbar',
|
||||||
|
'Left to Right Text (default)',
|
||||||
|
'MDI Child',
|
||||||
|
'No parent notify',
|
||||||
|
'Client & Window edge',
|
||||||
|
'Window & ToolWindow & TopMost edge',
|
||||||
|
'Right aligned',
|
||||||
|
'Right vertical scrollbar (default)',
|
||||||
|
'Right to Left text',
|
||||||
|
'Static edge',
|
||||||
|
'Tool window',
|
||||||
|
'Topmost',
|
||||||
|
'Transparent',
|
||||||
|
'Raised edge');
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
190
Writers.pas
Normal file
190
Writers.pas
Normal file
@ -0,0 +1,190 @@
|
|||||||
|
unit Writers;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Windows, SysUtils, Classes, Graphics;
|
||||||
|
|
||||||
|
type
|
||||||
|
TTextWriter = class
|
||||||
|
private
|
||||||
|
FStream: TStream;
|
||||||
|
FIdent: cardinal;
|
||||||
|
FWriteIdent: boolean;
|
||||||
|
procedure WriteIdent;
|
||||||
|
public
|
||||||
|
constructor Create(AStream: TStream);
|
||||||
|
constructor CreateFile(const FileName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
procedure NewLine;
|
||||||
|
procedure Write(const str: string);
|
||||||
|
procedure WriteLn(const str: string);
|
||||||
|
procedure WriteString(const str: string);
|
||||||
|
property Ident: cardinal read FIdent write FIdent;
|
||||||
|
property Stream: TStream read FStream;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDfmWriter = class(TTextWriter)
|
||||||
|
procedure WriteBinaryAsText(Input: TStream);
|
||||||
|
procedure WriteBoolProp(const Name: string; Value: boolean);
|
||||||
|
procedure WriteColorProp(const Name: string; Value: TColor);
|
||||||
|
procedure WriteCustomProp(const Name, Value: string);
|
||||||
|
procedure WriteIntProp(const Name: string; Value: integer);
|
||||||
|
procedure WriteStringProp(const Name, Value: string);
|
||||||
|
procedure WritePlacement(wnd, parent: HWND);
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
constructor TTextWriter.Create(AStream: TStream);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FStream := AStream;
|
||||||
|
FIdent := 0;
|
||||||
|
FWriteIdent := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TTextWriter.CreateFile(const FileName: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FStream := TFileStream.Create(FileName, fmCreate);
|
||||||
|
FIdent := 0;
|
||||||
|
FWriteIdent := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TTextWriter.Destroy;
|
||||||
|
begin
|
||||||
|
FStream.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextWriter.WriteIdent;
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
if FWriteIdent then
|
||||||
|
begin
|
||||||
|
if FIdent > 0 then
|
||||||
|
begin
|
||||||
|
s := '';
|
||||||
|
for i := 1 to FIdent do
|
||||||
|
s := s + ' ';
|
||||||
|
FStream.Write(s[1], FIdent);
|
||||||
|
end;
|
||||||
|
FWriteIdent := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextWriter.Write(const str: string);
|
||||||
|
begin
|
||||||
|
WriteIdent;
|
||||||
|
FStream.Write(str[1], Length(str));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextWriter.WriteLn(const str: string);
|
||||||
|
begin
|
||||||
|
Write(str);
|
||||||
|
NewLine;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextWriter.WriteString(const str: string);
|
||||||
|
begin
|
||||||
|
Write(Chr(Length(str)) + str);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTextWriter.NewLine;
|
||||||
|
const
|
||||||
|
crlf: array [0..1] of char = #13#10;
|
||||||
|
begin
|
||||||
|
FStream.Write(crlf[0], 2);
|
||||||
|
FWriteIdent := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteBoolProp(const Name: string; Value: boolean);
|
||||||
|
const
|
||||||
|
s: array [False..True] of string = ('False', 'True');
|
||||||
|
begin
|
||||||
|
WriteCustomProp(Name, s[Value]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteColorProp(const Name: string; Value: TColor);
|
||||||
|
begin
|
||||||
|
WriteCustomProp(Name, ColorToString(Value));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteCustomProp(const Name, Value: string);
|
||||||
|
begin
|
||||||
|
WriteLn(Name + ' = ' + Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteIntProp(const Name: string; Value: integer);
|
||||||
|
begin
|
||||||
|
WriteCustomProp(Name, IntToStr(Value));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteStringProp(const Name, Value: string);
|
||||||
|
begin
|
||||||
|
WriteCustomProp(Name, '''' + Value + '''');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure BinToHex(Binary, Text: PChar; Count: integer);
|
||||||
|
const
|
||||||
|
HexChars: array[0..15] of char = '0123456789ABCDEF';
|
||||||
|
var
|
||||||
|
I: integer;
|
||||||
|
begin
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
Text^ := HexChars[(byte(Binary[I]) and $F0) shr 4];
|
||||||
|
Inc(Text);
|
||||||
|
Text^ := HexChars[(byte(Binary[I]) and $0F)];
|
||||||
|
Inc(Text);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WriteBinaryAsText(Input: TStream);
|
||||||
|
const
|
||||||
|
BytesPerLine = 32;
|
||||||
|
var
|
||||||
|
MultiLine: boolean;
|
||||||
|
I: integer;
|
||||||
|
Count: longint;
|
||||||
|
Buffer: array[0..BytesPerLine - 1] of char;
|
||||||
|
Text: array[0..BytesPerLine * 2 - 1] of char;
|
||||||
|
begin
|
||||||
|
Count := Input.Size;
|
||||||
|
MultiLine := Count > BytesPerLine;
|
||||||
|
while Count > 0 do
|
||||||
|
begin
|
||||||
|
if MultiLine then
|
||||||
|
NewLine;
|
||||||
|
if Count >= BytesPerLine then
|
||||||
|
I := BytesPerLine
|
||||||
|
else
|
||||||
|
I := Count;
|
||||||
|
Input.Read(Buffer, I);
|
||||||
|
BinToHex(Buffer, Text, I);
|
||||||
|
Write(Text);
|
||||||
|
Dec(Count, I);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDfmWriter.WritePlacement(wnd, parent: HWND);
|
||||||
|
var
|
||||||
|
R: TRect;
|
||||||
|
begin
|
||||||
|
GetWindowRect(wnd, R);
|
||||||
|
if IsWindow(parent) then
|
||||||
|
begin
|
||||||
|
Windows.ScreenToClient(parent, R.TopLeft);
|
||||||
|
Windows.ScreenToClient(parent, R.BottomRight);
|
||||||
|
end;
|
||||||
|
WriteIntProp('Left', R.Left);
|
||||||
|
WriteIntProp('Top', R.Top);
|
||||||
|
WriteIntProp('Width', R.Right - R.Left);
|
||||||
|
WriteIntProp('Height', R.Bottom - R.Top);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
94
about1.lfm
Normal file
94
about1.lfm
Normal file
@ -0,0 +1,94 @@
|
|||||||
|
object AboutBox: TAboutBox
|
||||||
|
Left = 910
|
||||||
|
Height = 326
|
||||||
|
Top = 703
|
||||||
|
Width = 361
|
||||||
|
BorderStyle = bsDialog
|
||||||
|
Caption = 'About'
|
||||||
|
ClientHeight = 326
|
||||||
|
ClientWidth = 361
|
||||||
|
DesignTimePPI = 168
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Position = poScreenCenter
|
||||||
|
LCLVersion = '1.8.0.6'
|
||||||
|
object Panel1: TPanel
|
||||||
|
Left = 20
|
||||||
|
Height = 200
|
||||||
|
Top = 20
|
||||||
|
Width = 320
|
||||||
|
BevelInner = bvRaised
|
||||||
|
BevelOuter = bvLowered
|
||||||
|
ClientHeight = 200
|
||||||
|
ClientWidth = 320
|
||||||
|
TabOrder = 0
|
||||||
|
object ProductName: TLabel
|
||||||
|
Left = 20
|
||||||
|
Height = 29
|
||||||
|
Top = 20
|
||||||
|
Width = 117
|
||||||
|
Alignment = taCenter
|
||||||
|
Caption = 'Chameleon'
|
||||||
|
Font.CharSet = GREEK_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object Version: TLabel
|
||||||
|
Left = 20
|
||||||
|
Height = 29
|
||||||
|
Top = 60
|
||||||
|
Width = 139
|
||||||
|
Alignment = taCenter
|
||||||
|
Caption = 'Version 0.0.2'
|
||||||
|
Font.CharSet = GREEK_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object Copyright: TLabel
|
||||||
|
Left = 20
|
||||||
|
Height = 29
|
||||||
|
Top = 100
|
||||||
|
Width = 231
|
||||||
|
Alignment = taCenter
|
||||||
|
Caption = '(C) Nikolaos Georgiou'
|
||||||
|
Font.CharSet = GREEK_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
end
|
||||||
|
object Comments: TLabel
|
||||||
|
Left = 20
|
||||||
|
Height = 29
|
||||||
|
Top = 140
|
||||||
|
Width = 128
|
||||||
|
Alignment = taCenter
|
||||||
|
Caption = 'MIT License'
|
||||||
|
Font.CharSet = GREEK_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
ParentColor = False
|
||||||
|
ParentFont = False
|
||||||
|
WordWrap = True
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object OKButton: TButton
|
||||||
|
Left = 110
|
||||||
|
Height = 65
|
||||||
|
Top = 240
|
||||||
|
Width = 140
|
||||||
|
Caption = 'OK'
|
||||||
|
Default = True
|
||||||
|
ModalResult = 1
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
32
about1.pas
Normal file
32
about1.pas
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
unit about1;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
|
||||||
|
Buttons, ExtCtrls;
|
||||||
|
|
||||||
|
type
|
||||||
|
TAboutBox = class(TForm)
|
||||||
|
Panel1: TPanel;
|
||||||
|
ProductName: TLabel;
|
||||||
|
Version: TLabel;
|
||||||
|
Copyright: TLabel;
|
||||||
|
Comments: TLabel;
|
||||||
|
OKButton: TButton;
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
AboutBox: TAboutBox;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
228
frmMain.lfm
Normal file
228
frmMain.lfm
Normal file
@ -0,0 +1,228 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 645
|
||||||
|
Height = 522
|
||||||
|
Top = 560
|
||||||
|
Width = 750
|
||||||
|
BorderIcons = [biSystemMenu]
|
||||||
|
BorderStyle = bsSingle
|
||||||
|
Caption = 'Chameleon'
|
||||||
|
ClientHeight = 522
|
||||||
|
ClientWidth = 750
|
||||||
|
Color = clBtnFace
|
||||||
|
DesignTimePPI = 168
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
LCLVersion = '1.8.0.6'
|
||||||
|
object lblDelayTime: TLabel
|
||||||
|
Left = 36
|
||||||
|
Height = 29
|
||||||
|
Top = 20
|
||||||
|
Width = 294
|
||||||
|
Caption = 'Time until restoring control:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label1: TLabel
|
||||||
|
Left = 478
|
||||||
|
Height = 29
|
||||||
|
Top = 20
|
||||||
|
Width = 55
|
||||||
|
Caption = 'msec'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object DelayTime: TSpinEdit
|
||||||
|
Left = 360
|
||||||
|
Height = 37
|
||||||
|
Top = 20
|
||||||
|
Width = 111
|
||||||
|
MaxValue = 0
|
||||||
|
TabOrder = 0
|
||||||
|
Value = 3000
|
||||||
|
end
|
||||||
|
object PageControl1: TPageControl
|
||||||
|
Left = 36
|
||||||
|
Height = 396
|
||||||
|
Top = 100
|
||||||
|
Width = 692
|
||||||
|
ActivePage = InformationSheet
|
||||||
|
TabIndex = 0
|
||||||
|
TabOrder = 1
|
||||||
|
object InformationSheet: TTabSheet
|
||||||
|
Caption = 'Get information'
|
||||||
|
ClientHeight = 354
|
||||||
|
ClientWidth = 684
|
||||||
|
object lblWndValue: TLabel
|
||||||
|
Left = 56
|
||||||
|
Height = 29
|
||||||
|
Top = 160
|
||||||
|
Width = 134
|
||||||
|
Caption = 'HWND value'
|
||||||
|
Enabled = False
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Information: TButton
|
||||||
|
Left = 36
|
||||||
|
Height = 72
|
||||||
|
Top = 240
|
||||||
|
Width = 504
|
||||||
|
Caption = 'Get information'
|
||||||
|
OnClick = InformationClick
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
object WndValue: TEdit
|
||||||
|
Left = 223
|
||||||
|
Height = 37
|
||||||
|
Top = 160
|
||||||
|
Width = 121
|
||||||
|
Enabled = False
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object optAutomatic: TRadioButton
|
||||||
|
Left = 24
|
||||||
|
Height = 33
|
||||||
|
Top = 20
|
||||||
|
Width = 185
|
||||||
|
Caption = 'Select window'
|
||||||
|
Checked = True
|
||||||
|
OnClick = optAutomaticClick
|
||||||
|
TabOrder = 0
|
||||||
|
TabStop = True
|
||||||
|
end
|
||||||
|
object optManual: TRadioButton
|
||||||
|
Left = 24
|
||||||
|
Height = 33
|
||||||
|
Top = 100
|
||||||
|
Width = 320
|
||||||
|
Caption = 'Type in the window handle'
|
||||||
|
OnClick = optManualClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object DelphiFormSheet: TTabSheet
|
||||||
|
Caption = 'Create Delphi form'
|
||||||
|
ClientHeight = 354
|
||||||
|
ClientWidth = 684
|
||||||
|
object Label3: TLabel
|
||||||
|
Left = 36
|
||||||
|
Height = 29
|
||||||
|
Top = 20
|
||||||
|
Width = 148
|
||||||
|
Caption = 'Unit file name'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object Label4: TLabel
|
||||||
|
Left = 36
|
||||||
|
Height = 29
|
||||||
|
Top = 140
|
||||||
|
Width = 122
|
||||||
|
Caption = 'Form name'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object PasFileName: TEdit
|
||||||
|
Left = 36
|
||||||
|
Height = 37
|
||||||
|
Top = 60
|
||||||
|
Width = 324
|
||||||
|
OnChange = PasEditChange
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object BrowsePas: TButton
|
||||||
|
Left = 360
|
||||||
|
Height = 37
|
||||||
|
Top = 60
|
||||||
|
Width = 144
|
||||||
|
Caption = 'Browse...'
|
||||||
|
OnClick = BrowsePasClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object FormName: TEdit
|
||||||
|
Left = 36
|
||||||
|
Height = 37
|
||||||
|
Top = 180
|
||||||
|
Width = 468
|
||||||
|
OnChange = PasEditChange
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object SavePas: TButton
|
||||||
|
Left = 36
|
||||||
|
Height = 72
|
||||||
|
Top = 240
|
||||||
|
Width = 468
|
||||||
|
Caption = 'Select window and save it'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = SavePasClick
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object RCSheet: TTabSheet
|
||||||
|
Caption = 'Create resource script'
|
||||||
|
ClientHeight = 354
|
||||||
|
ClientWidth = 684
|
||||||
|
object Label2: TLabel
|
||||||
|
Left = 36
|
||||||
|
Height = 29
|
||||||
|
Top = 20
|
||||||
|
Width = 135
|
||||||
|
Caption = 'RC file name'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object RCFileName: TEdit
|
||||||
|
Left = 36
|
||||||
|
Height = 37
|
||||||
|
Top = 60
|
||||||
|
Width = 293
|
||||||
|
OnChange = RCFileNameChange
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object BrowseRC: TButton
|
||||||
|
Left = 324
|
||||||
|
Height = 37
|
||||||
|
Top = 60
|
||||||
|
Width = 144
|
||||||
|
Caption = 'Browse...'
|
||||||
|
OnClick = BrowseRCClick
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object SaveRC: TButton
|
||||||
|
Left = 36
|
||||||
|
Height = 72
|
||||||
|
Top = 180
|
||||||
|
Width = 432
|
||||||
|
Caption = 'Select window and save it'
|
||||||
|
Enabled = False
|
||||||
|
OnClick = SaveRCClick
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object BitBtn1: TBitBtn
|
||||||
|
Left = 565
|
||||||
|
Height = 64
|
||||||
|
Top = 20
|
||||||
|
Width = 163
|
||||||
|
Caption = 'About...'
|
||||||
|
Glyph.Data = {
|
||||||
|
76010000424D7601000000000000760000002800000020000000100000000100
|
||||||
|
04000000000000010000120B0000120B00001000000000000000000000000000
|
||||||
|
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
|
||||||
|
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333303333
|
||||||
|
333333333337FF3333333333330003333333333333777F333333333333080333
|
||||||
|
3333333F33777FF33F3333B33B000B33B3333373F777773F7333333BBB0B0BBB
|
||||||
|
33333337737F7F77F333333BBB0F0BBB33333337337373F73F3333BBB0F7F0BB
|
||||||
|
B333337F3737F73F7F3333BB0FB7BF0BB3333F737F37F37F73FFBBBB0BF7FB0B
|
||||||
|
BBB3773F7F37337F377333BB0FBFBF0BB333337F73F333737F3333BBB0FBF0BB
|
||||||
|
B3333373F73FF7337333333BBB000BBB33333337FF777337F333333BBBBBBBBB
|
||||||
|
3333333773FF3F773F3333B33BBBBB33B33333733773773373333333333B3333
|
||||||
|
333333333337F33333333333333B333333333333333733333333
|
||||||
|
}
|
||||||
|
ModalResult = 3
|
||||||
|
NumGlyphs = 2
|
||||||
|
OnClick = BitBtn1Click
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object SaveDialog1: TSaveDialog
|
||||||
|
Options = [ofOverwritePrompt, ofHideReadOnly]
|
||||||
|
left = 640
|
||||||
|
top = 420
|
||||||
|
end
|
||||||
|
end
|
||||||
330
frmMain.pas
Normal file
330
frmMain.pas
Normal file
@ -0,0 +1,330 @@
|
|||||||
|
unit frmMain;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
StdCtrls, ExtCtrls, Spin, ComCtrls, Buttons;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TMainForm }
|
||||||
|
|
||||||
|
TMainForm = class(TForm)
|
||||||
|
DelayTime: TSpinEdit;
|
||||||
|
lblDelayTime: TLabel;
|
||||||
|
Label1: TLabel;
|
||||||
|
SaveDialog1: TSaveDialog;
|
||||||
|
PageControl1: TPageControl;
|
||||||
|
InformationSheet: TTabSheet;
|
||||||
|
DelphiFormSheet: TTabSheet;
|
||||||
|
Information: TButton;
|
||||||
|
WndValue: TEdit;
|
||||||
|
Label3: TLabel;
|
||||||
|
PasFileName: TEdit;
|
||||||
|
BrowsePas: TButton;
|
||||||
|
Label4: TLabel;
|
||||||
|
FormName: TEdit;
|
||||||
|
SavePas: TButton;
|
||||||
|
lblWndValue: TLabel;
|
||||||
|
optAutomatic: TRadioButton;
|
||||||
|
optManual: TRadioButton;
|
||||||
|
RCSheet: TTabSheet;
|
||||||
|
Label2: TLabel;
|
||||||
|
RCFileName: TEdit;
|
||||||
|
BrowseRC: TButton;
|
||||||
|
SaveRC: TButton;
|
||||||
|
BitBtn1: TBitBtn;
|
||||||
|
procedure InformationClick(Sender: TObject);
|
||||||
|
procedure BrowsePasClick(Sender: TObject);
|
||||||
|
procedure BrowseRCClick(Sender: TObject);
|
||||||
|
procedure SavePasClick(Sender: TObject);
|
||||||
|
procedure PasEditChange(Sender: TObject);
|
||||||
|
procedure optManualClick(Sender: TObject);
|
||||||
|
procedure optAutomaticClick(Sender: TObject);
|
||||||
|
procedure RCFileNameChange(Sender: TObject);
|
||||||
|
procedure BitBtn1Click(Sender: TObject);
|
||||||
|
procedure SaveRCClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
procedure GenerateDfmFile(const filename, frmname: string;
|
||||||
|
wnd: HWND; PasList: TStrings);
|
||||||
|
procedure GeneratePasFile(const filename, frmname: string; PasList: TStrings);
|
||||||
|
procedure GetWinInfo(wnd: HWND; ParentNode: TTreeNode);
|
||||||
|
procedure EnableSavePas;
|
||||||
|
procedure EnableWndInput;
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
MainForm: TMainForm;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses frmResults, Writers, DfmEngine, StrConsts, about1;
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
procedure TMainForm.GetWinInfo(wnd: HWND; ParentNode: TTreeNode);
|
||||||
|
var
|
||||||
|
len, i, cbcount: integer;
|
||||||
|
Text: PChar;
|
||||||
|
class_name: array [0..100] of char;
|
||||||
|
R1, R2: TRect;
|
||||||
|
node1, node2: TTreeNode;
|
||||||
|
childlist: TList;
|
||||||
|
EnumParams: TEnumParams;
|
||||||
|
style, exstyle: integer;
|
||||||
|
parentWnd: HWND;
|
||||||
|
itemtext: array [0..300] of char;
|
||||||
|
begin
|
||||||
|
if not IsWindow(wnd) then
|
||||||
|
begin
|
||||||
|
Results.TreeView1.Items.AddChild(ParentNode, 'Handle = (INVALID HANDLE)');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
childlist := TList.Create;
|
||||||
|
len := GetWindowTextLength(wnd) + 1;
|
||||||
|
GetMem(Text, len);
|
||||||
|
GetWindowText(wnd, Text, len);
|
||||||
|
GetWindowRect(wnd, R1);
|
||||||
|
Windows.GetClientRect(wnd, R2);
|
||||||
|
GetClassName(wnd, class_name, 100);
|
||||||
|
style := GetWindowLong(wnd, GWL_STYLE);
|
||||||
|
exstyle := GetWindowLong(wnd, GWL_EXSTYLE);
|
||||||
|
parentWnd := GetParent(wnd);
|
||||||
|
EnumParams.List := childlist;
|
||||||
|
EnumParams.ParentWnd := wnd;
|
||||||
|
EnumChildWindows(wnd, @EnumChildrenProc, integer(@EnumParams));
|
||||||
|
|
||||||
|
with Results.TreeView1.Items do
|
||||||
|
begin
|
||||||
|
AddChild(ParentNode, 'Handle = ' + IntToStr(wnd));
|
||||||
|
AddChild(ParentNode, 'Caption = ' + Text);
|
||||||
|
AddChild(ParentNode, 'Class name = ' + class_name);
|
||||||
|
AddChild(ParentNode, 'Parent Handle = ' + IntToStr(parentWnd));
|
||||||
|
node1 := AddChild(ParentNode, 'Style');
|
||||||
|
AddChild(node1, 'Value = ' + IntToStr(style));
|
||||||
|
for i := Low(WindowStyle) to High(WindowStyle) do
|
||||||
|
if ((style and WindowStyle[i]) = WindowStyle[i]) then
|
||||||
|
AddChild(node1, WindowStyleName[i]);
|
||||||
|
|
||||||
|
node1 := AddChild(ParentNode, 'Extended Style');
|
||||||
|
AddChild(node1, 'Value = ' + IntToStr(exstyle));
|
||||||
|
for i := Low(WindowStyle) to High(WindowStyle) do
|
||||||
|
if ((style and ExtendedWindowStyle[i]) = ExtendedWindowStyle[i]) then
|
||||||
|
AddChild(node1, ExtendedWindowStyleName[i]);
|
||||||
|
node1 := AddChild(ParentNode, 'Placement');
|
||||||
|
AddChild(node1, 'Left = ' + IntToStr(R1.Left));
|
||||||
|
AddChild(node1, 'Top = ' + IntToStr(R1.Top));
|
||||||
|
AddChild(node1, 'Width = ' + IntToStr(R1.Right - R1.Left));
|
||||||
|
AddChild(node1, 'Height = ' + IntToStr(R1.Bottom - R1.Top));
|
||||||
|
AddChild(node1, 'ClientWidth = ' + IntToStr(R2.Right));
|
||||||
|
AddChild(node1, 'ClientHeight = ' + IntToStr(R2.Bottom));
|
||||||
|
if (CompareText(class_name, 'COMBOBOX') = 0) then
|
||||||
|
begin
|
||||||
|
node1 := AddChild(ParentNode, '[List Data]');
|
||||||
|
cbcount := SendMessage(wnd, CB_GETCOUNT, 0, 0);
|
||||||
|
for i := 1 to cbcount do
|
||||||
|
begin
|
||||||
|
SendMessage(wnd, CB_GETLBTEXT, i - 1, longint(@itemtext));
|
||||||
|
node2 := AddChild(node1, 'Item #' + IntToStr(i));
|
||||||
|
AddChild(node2, 'Text = ' + itemtext);
|
||||||
|
AddChild(node2, 'Data = ' + IntToStr(SendMessage(wnd, CB_GETITEMDATA, i - 1, 0)));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if childlist.Count > 0 then
|
||||||
|
begin
|
||||||
|
node1 := AddChild(ParentNode, 'Children information');
|
||||||
|
for i := 1 to childlist.Count do
|
||||||
|
begin
|
||||||
|
node2 := AddChild(node1, 'Child #' + IntToStr(i));
|
||||||
|
GetWinInfo(integer(childlist[i - 1]), node2);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
FreeMem(Text);
|
||||||
|
childlist.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.InformationClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
wnd: HWND;
|
||||||
|
begin
|
||||||
|
if optAutomatic.Checked then
|
||||||
|
begin
|
||||||
|
Application.Minimize;
|
||||||
|
Sleep(DelayTime.Value);
|
||||||
|
wnd := GetForegroundWindow;
|
||||||
|
Application.Restore;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
wnd := StrToInt(WndValue.Text);
|
||||||
|
|
||||||
|
Results.Show;
|
||||||
|
Results.TreeView1.Items.Clear;
|
||||||
|
GetWinInfo(wnd, nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BrowsePasClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
with SaveDialog1 do
|
||||||
|
begin
|
||||||
|
FileName := '';
|
||||||
|
DefaultExt := 'pas';
|
||||||
|
Filter := 'Delphi Units|*.pas';
|
||||||
|
if Execute then
|
||||||
|
begin
|
||||||
|
PasFileName.Text := FileName;
|
||||||
|
s := ChangeFileExt(ExtractFileName(FileName), '');
|
||||||
|
if LowerCase(Copy(s, 1, 3)) = 'frm' then
|
||||||
|
s := Copy(s, 4, Length(s) - 3) + 'Form'
|
||||||
|
else
|
||||||
|
s := s + 'Form';
|
||||||
|
FormName.Text := s;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BrowseRCClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
with SaveDialog1 do
|
||||||
|
begin
|
||||||
|
FileName := '';
|
||||||
|
DefaultExt := 'rc';
|
||||||
|
Filter := 'Resource scripts|*.rc';
|
||||||
|
// if Execute then RCFileName.Text := FileName;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.GenerateDfmFile(const filename, frmName: string;
|
||||||
|
wnd: HWND; PasList: TStrings);
|
||||||
|
var
|
||||||
|
OutStream: TFileStream;
|
||||||
|
b1: TDfmBuilder;
|
||||||
|
begin
|
||||||
|
b1 := TDfmBuilder.Create(PasList);
|
||||||
|
OutStream := TFileStream.Create(filename, fmCreate);
|
||||||
|
b1.Build(OutStream, frmName, wnd);
|
||||||
|
OutStream.Free;
|
||||||
|
b1.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.GeneratePasFile(const filename, frmname: string; PasList: TStrings);
|
||||||
|
var
|
||||||
|
title: string;
|
||||||
|
fpas: TTextWriter;
|
||||||
|
i: integer;
|
||||||
|
begin
|
||||||
|
fpas := TTextWriter.CreateFile(filename);
|
||||||
|
try
|
||||||
|
title := ChangeFileExt(ExtractFileName(filename), '');
|
||||||
|
with fpas do
|
||||||
|
begin
|
||||||
|
WriteLn('unit ' + title + ';');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('interface');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('uses');
|
||||||
|
WriteLn(' Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,');
|
||||||
|
WriteLn(' StdCtrls;');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('type');
|
||||||
|
WriteLn(' T' + frmname + ' = class(TForm)');
|
||||||
|
for i := 0 to PasList.Count - 1 do
|
||||||
|
WriteLn(' ' + PasList[i]);
|
||||||
|
WriteLn(' private');
|
||||||
|
WriteLn(' { Private declarations }');
|
||||||
|
WriteLn(' public');
|
||||||
|
WriteLn(' { Public declarations }');
|
||||||
|
WriteLn(' end;');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('var');
|
||||||
|
WriteLn(' ' + frmname + ': T' + frmname + ';');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('implementation');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('{$R *.DFM}');
|
||||||
|
WriteLn('');
|
||||||
|
WriteLn('end.');
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
fpas.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.SavePasClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
dfmName: string;
|
||||||
|
wnd: HWND;
|
||||||
|
s: TStringList;
|
||||||
|
begin
|
||||||
|
Application.Minimize;
|
||||||
|
Sleep(DelayTime.Value);
|
||||||
|
|
||||||
|
wnd := GetForegroundWindow;
|
||||||
|
Application.Restore;
|
||||||
|
|
||||||
|
dfmName := ChangeFileExt(PasFileName.Text, '.dfm');
|
||||||
|
s := TStringList.Create;
|
||||||
|
GenerateDfmFile(dfmName, FormName.Text, wnd, s);
|
||||||
|
GeneratePasFile(PasFileName.Text, FormName.Text, s);
|
||||||
|
s.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.EnableSavePas;
|
||||||
|
var
|
||||||
|
UnitName: string;
|
||||||
|
begin
|
||||||
|
UnitName := ChangeFileExt(ExtractFileName(PasFileName.Text), '');
|
||||||
|
SavePas.Enabled := IsValidIdent(FormName.Text) and IsValidIdent(UnitName) and
|
||||||
|
(CompareText(UnitName, FormName.Text) <> 0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.PasEditChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
EnableSavePas;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.EnableWndInput;
|
||||||
|
begin
|
||||||
|
WndValue.Enabled := optManual.Checked;
|
||||||
|
lblWndValue.Enabled := optManual.Checked;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.optManualClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
EnableWndInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.optAutomaticClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
EnableWndInput;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.RCFileNameChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
SaveRC.Enabled := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BitBtn1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
AboutBox.ShowModal;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.SaveRCClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
32
frmResults.lfm
Normal file
32
frmResults.lfm
Normal file
@ -0,0 +1,32 @@
|
|||||||
|
object Results: TResults
|
||||||
|
Left = 197
|
||||||
|
Height = 395
|
||||||
|
Top = 144
|
||||||
|
Width = 390
|
||||||
|
Caption = 'Chameleon Information'
|
||||||
|
ClientHeight = 395
|
||||||
|
ClientWidth = 390
|
||||||
|
Color = clBtnFace
|
||||||
|
DesignTimePPI = 168
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -24
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
LCLVersion = '1.8.0.6'
|
||||||
|
object TreeView1: TTreeView
|
||||||
|
Left = 0
|
||||||
|
Height = 395
|
||||||
|
Top = 0
|
||||||
|
Width = 390
|
||||||
|
Align = alClient
|
||||||
|
Indent = 19
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object popListData: TPopupMenu
|
||||||
|
left = 101
|
||||||
|
top = 15
|
||||||
|
object Savelistdata1: TMenuItem
|
||||||
|
Caption = 'Save list data...'
|
||||||
|
OnClick = Savelistdata1Click
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
66
frmResults.pas
Normal file
66
frmResults.pas
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
unit frmResults;
|
||||||
|
|
||||||
|
{$MODE Delphi}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||||
|
ComCtrls, Menus;
|
||||||
|
|
||||||
|
type
|
||||||
|
TResults = class(TForm)
|
||||||
|
popListData: TPopupMenu;
|
||||||
|
Savelistdata1: TMenuItem;
|
||||||
|
TreeView1: TTreeView;
|
||||||
|
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
|
||||||
|
procedure Savelistdata1Click(Sender: TObject);
|
||||||
|
private
|
||||||
|
{ Private declarations }
|
||||||
|
public
|
||||||
|
{ Public declarations }
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Results: TResults;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
|
||||||
|
procedure TResults.TreeView1Change(Sender: TObject; Node: TTreeNode);
|
||||||
|
begin
|
||||||
|
if (Assigned(Node) and (Node.Text = '[List Data]')) then
|
||||||
|
TreeView1.PopupMenu := popListData
|
||||||
|
else
|
||||||
|
TreeView1.PopupMenu := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TResults.Savelistdata1Click(Sender: TObject);
|
||||||
|
var
|
||||||
|
f: TextFile;
|
||||||
|
n: TTreeNode;
|
||||||
|
i: integer;
|
||||||
|
|
||||||
|
function RemoveTag(const s: string): string;
|
||||||
|
var
|
||||||
|
pos1: integer;
|
||||||
|
begin
|
||||||
|
pos1 := Pos('=', s);
|
||||||
|
Result := Copy(s, pos1 + 2, Length(s) - pos1 - 1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AssignFile(f, 'c:\listdata.csv');
|
||||||
|
Rewrite(f);
|
||||||
|
n := TreeView1.Selected;
|
||||||
|
for i := 0 to n.Count - 1 do
|
||||||
|
begin
|
||||||
|
WriteLn(f, i, ';', RemoveTag(n.Items[i].Items[0].Text), ';',
|
||||||
|
RemoveTag(n.Items[i].Items[1].Text));
|
||||||
|
end;
|
||||||
|
CloseFile(f);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user