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