Personale/Chameleon
1
0
Fork 0
mirror of https://github.com/ngeor/Chameleon.git synced 2025-12-19 09:53:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #11 from ngeor/instarepo_branch

Browse Source 
instarepo automatic PR
This commit is contained in:
Nikolaos Georgiou 2022-09-09 19:28:18 +02:00 committed by GitHub
commit e69d79e4e4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 126 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
DfmEngine.pas
View File

@ -14,77 +14,77 @@ type
kcPanel, kcRadioButton, kcStatusBar, kcTreeView
);
TKnownControls = set of TKnownControl;
TKnownControlHandlerProc = procedure(wnd: HWND; style: integer) of object;
TKnownControlHandlerProc = procedure(wnd: HWND; style: Integer) of object;
TDfmBuilder = class
private
PasList: TStrings;
dfm1: TDfmWriter;
Counts: array[TKnownControl] of integer;
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 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);
procedure Build(OutStream: TStream; const frmName: String; wnd: HWND);
end;
const
KCNames: array[TKnownControl] of string = (
KCNames: array[TKnownControl] of String = (
'Unknown', 'Button', 'CheckBox', 'ComboBox', 'Edit',
'GroupBox', 'Image', 'Label', 'ListBox', 'ListView',
'Panel', 'RadioButton', 'StatusBar', 'TreeView'
);
KCClassNames: array[TKnownControl] of string = (
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 BitTest(Value, Mask: Integer): Boolean;
function GetWndText(wnd: HWND): String;
procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP;
BelongsToPicture: boolean; const Name: string);
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean;
const Name: string);
BelongsToPicture: Boolean; const Name: String);
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: Boolean;
const Name: String);
implementation
uses WindowEnumerator;
function BitTest(Value, Mask: integer): boolean;
function BitTest(Value, Mask: Integer): Boolean;
begin
Result := (Value and Mask) = Mask;
end;
function GetWndText(wnd: HWND): string;
function GetWndText(wnd: HWND): String;
var
len: integer;
len: Integer;
begin
len := GetWindowTextLength(wnd);
SetLength(Result, len);
GetWindowText(wnd, PChar(Result), len + 1);
end;
function GetBorderIconsStr(ABorderIcons: TBorderIcons): string;
function GetBorderIconsStr(ABorderIcons: TBorderIcons): String;
const
biStr: array [TBorderIcon] of string = (
biStr: array [TBorderIcon] of String = (
'biSystemMenu', 'biMinimize', 'biMaximize', 'biHelp');
var
k: TBorderIcon;
@ -108,17 +108,17 @@ begin
PasList := APasList;
end;
procedure TDfmBuilder.Build(OutStream: TStream; const frmName: string; wnd: HWND);
procedure TDfmBuilder.Build(OutStream: TStream; const frmName: String; wnd: HWND);
var
InStream: TMemoryStream;
i: integer;
style, exstyle: longint;
i: Integer;
style, exstyle: Longint;
wndX: HWND;
procedure WriteBorderIcons;
var
bi: TBorderIcons;
s: string;
s: String;
begin
bi := [];
if BitTest(style, WS_SYSMENU) then
@ -167,10 +167,10 @@ begin
DFM1.Free;
end;
procedure TDfmBuilder.HandleUnknown(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleUnknown(wnd: HWND; style: Integer);
var
class_name: array [0..100] of char;
i: integer;
class_name: array [0..100] of Char;
i: Integer;
begin
// since we don't know what window we're after write the class name
GetClassName(wnd, class_name, 100);
@ -178,18 +178,18 @@ begin
EnumerateChildWindows(wnd, Self.PreHandleCtl);
end;
procedure TDfmBuilder.HandleButton(wnd: HWND; style: integer);
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);
procedure TDfmBuilder.HandleCheckBox(wnd: HWND; style: Integer);
const
CheckedStr: array [0..2] of string = ('cbUnchecked', 'cbChecked', 'cbGrayed');
CheckedStr: array [0..2] of String = ('cbUnchecked', 'cbChecked', 'cbGrayed');
var
state: integer;
allowgrayed: boolean;
state: Integer;
allowgrayed: Boolean;
begin
allowgrayed := BitTest(style, BS_3STATE) or BitTest(style, BS_AUTO3STATE);
state := SendMessage(wnd, BM_GETCHECK, 0, 0);
@ -198,23 +198,23 @@ begin
dfm1.WriteCustomProp('State', CheckedStr[state]);
end;
procedure TDfmBuilder.HandleComboBox(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleComboBox(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleEdit(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleEdit(wnd: HWND; style: Integer);
begin
dfm1.WriteStringProp('Text', GetWndText(wnd));
end;
procedure TDfmBuilder.HandleGroupBox(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleGroupBox(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleImage(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleImage(wnd: HWND; style: Integer);
var
h: THANDLE;
OnlyIcon: boolean;
OnlyIcon: Boolean;
begin
OnlyIcon := BitTest(style, SS_ICON);
if OnlyIcon then
@ -235,43 +235,43 @@ begin
end;
end;
procedure TDfmBuilder.HandleLabel(wnd: HWND; style: integer);
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);
procedure TDfmBuilder.HandleListBox(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleListView(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleListView(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandlePanel(wnd: HWND; style: integer);
procedure TDfmBuilder.HandlePanel(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleRadioButton(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleRadioButton(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleStatusBar(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleStatusBar(wnd: HWND; style: Integer);
begin
end;
procedure TDfmBuilder.HandleTreeView(wnd: HWND; style: integer);
procedure TDfmBuilder.HandleTreeView(wnd: HWND; style: Integer);
begin
end;
procedure WriteBitmapData(dfm1: TDfmWriter; bmp: HBITMAP;
BelongsToPicture: boolean; const Name: string);
BelongsToPicture: Boolean; const Name: String);
var
b: TBitmap;
Memory: TTextWriter;
Size, Offset: integer;
Size, Offset: Integer;
begin
b := TBitmap.Create;
Memory := TTextWriter.Create(TMemoryStream.Create);
@ -301,8 +301,8 @@ begin
end;
end;
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: boolean;
const Name: string);
procedure WriteIconData(dfm1: TDfmWriter; icon: HICON; BelongsToPicture: Boolean;
const Name: String);
var
i: TIcon;
k: TTextWriter;
@ -332,7 +332,7 @@ end;
procedure TDfmBuilder.WriteDecl;
var
s: string;
s: String;
begin
Inc(Counts[CtlType]);
s := KCNames[CtlType] + IntToStr(Counts[CtlType]) + ': ' + KCClassNames[CtlType];
@ -341,7 +341,7 @@ begin
dfm1.Ident := dfm1.Ident + 2;
end;
procedure TDfmBuilder.DispatchHandle(wnd: HWND; style: integer);
procedure TDfmBuilder.DispatchHandle(wnd: HWND; style: Integer);
begin
case CtlType of
kcUnknown: HandleUnknown(wnd, style);
@ -363,8 +363,8 @@ end;
procedure TDfmBuilder.PreHandleCtl(wnd: HWND);
var
class_name: array [0..100] of char;
style: integer;
class_name: array [0..100] of Char;
style: Integer;
begin
GetClassName(wnd, class_name, 100);
style := GetWindowLong(wnd, GWL_STYLE);

6
StyleNames.pas
View File

@ -38,7 +38,7 @@ const
WS_VISIBLE,
WS_VSCROLL);
WindowStyleName: array [0..21] of string = (
WindowStyleName: array [0..21] of String = (
'Border',
'Caption',
'Child',
@ -62,7 +62,7 @@ const
'Visible',
'Vertical scroll bar');
ExtendedWindowStyle: array [0..20] of integer = (
ExtendedWindowStyle: array [0..20] of Integer = (
WS_EX_ACCEPTFILES,
WS_EX_APPWINDOW,
WS_EX_CLIENTEDGE,
@ -85,7 +85,7 @@ const
WS_EX_TRANSPARENT,
WS_EX_WINDOWEDGE);
ExtendedWindowStyleName: array [0..20] of string = (
ExtendedWindowStyleName: array [0..20] of String = (
'Drag drop recepient',
'Minimize on taskbar',
'Sunken edge border',

3
WindowEnumerator.pas
View File

@ -9,7 +9,7 @@ uses
type
{ An object method that accepts a HWND }
TWndConsumer = procedure (Wnd: HWND) of object;
TWndConsumer = procedure(Wnd: HWND) of object;
{ Calls the given consumer for every child window of the given window }
procedure EnumerateChildWindows(Wnd: HWND; Consumer: TWndConsumer);
@ -19,6 +19,7 @@ implementation
type
{ Wrapper structure to hold the object procedure and pass it as a pointer }
PWrapper = ^TWrapper;
TWrapper = record
Consumer: TWndConsumer;
end;

70
Writers.pas
View File

@ -10,28 +10,28 @@ type
TTextWriter = class
private
FStream: TStream;
FIdent: cardinal;
FWriteIdent: boolean;
FIdent: Cardinal;
FWriteIdent: Boolean;
procedure WriteIdent;
public
constructor Create(AStream: TStream);
constructor CreateFile(const FileName: string);
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;
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 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;
@ -45,7 +45,7 @@ begin
FWriteIdent := True;
end;
constructor TTextWriter.CreateFile(const FileName: string);
constructor TTextWriter.CreateFile(const FileName: String);
begin
inherited Create;
FStream := TFileStream.Create(FileName, fmCreate);
@ -61,8 +61,8 @@ end;
procedure TTextWriter.WriteIdent;
var
s: string;
i: integer;
s: String;
i: Integer;
begin
if FWriteIdent then
begin
@ -77,69 +77,69 @@ begin
end;
end;
procedure TTextWriter.Write(const str: string);
procedure TTextWriter.Write(const str: String);
begin
WriteIdent;
FStream.Write(str[1], Length(str));
end;
procedure TTextWriter.WriteLn(const str: string);
procedure TTextWriter.WriteLn(const str: String);
begin
Write(str);
NewLine;
end;
procedure TTextWriter.WriteString(const str: string);
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;
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);
procedure TDfmWriter.WriteBoolProp(const Name: String; Value: Boolean);
const
s: array [False..True] of string = ('False', 'True');
s: array [False..True] of String = ('False', 'True');
begin
WriteCustomProp(Name, s[Value]);
end;
procedure TDfmWriter.WriteColorProp(const Name: string; Value: TColor);
procedure TDfmWriter.WriteColorProp(const Name: String; Value: TColor);
begin
WriteCustomProp(Name, ColorToString(Value));
end;
procedure TDfmWriter.WriteCustomProp(const Name, Value: string);
procedure TDfmWriter.WriteCustomProp(const Name, Value: String);
begin
WriteLn(Name + ' = ' + Value);
end;
procedure TDfmWriter.WriteIntProp(const Name: string; Value: integer);
procedure TDfmWriter.WriteIntProp(const Name: String; Value: Integer);
begin
WriteCustomProp(Name, IntToStr(Value));
end;
procedure TDfmWriter.WriteStringProp(const Name, Value: string);
procedure TDfmWriter.WriteStringProp(const Name, Value: String);
begin
WriteCustomProp(Name, '''' + Value + '''');
end;
procedure BinToHex(Binary, Text: PChar; Count: integer);
procedure BinToHex(Binary, Text: PChar; Count: Integer);
const
HexChars: array[0..15] of char = '0123456789ABCDEF';
HexChars: array[0..15] of Char = '0123456789ABCDEF';
var
I: integer;
I: Integer;
begin
for I := 0 to Count - 1 do
begin
Text^ := HexChars[(byte(Binary[I]) and $F0) shr 4];
Text^ := HexChars[(Byte(Binary[I]) and $F0) shr 4];
Inc(Text);
Text^ := HexChars[(byte(Binary[I]) and $0F)];
Text^ := HexChars[(Byte(Binary[I]) and $0F)];
Inc(Text);
end;
end;
@ -148,11 +148,11 @@ 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;
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;

18
frmMain.pas
View File

@ -48,9 +48,9 @@ type
procedure btnAboutClick(Sender: TObject);
procedure SaveRCClick(Sender: TObject);
private
procedure GenerateDfmFile(const filename, frmname: string; wnd: HWND;
procedure GenerateDfmFile(const filename, frmname: String; wnd: HWND;
PasList: TStrings);
procedure GeneratePasFile(const filename, frmname: string; PasList: TStrings);
procedure GeneratePasFile(const filename, frmname: String; PasList: TStrings);
procedure EnableSavePas;
procedure EnableWndInput;
public
@ -87,7 +87,7 @@ end;
procedure TMainForm.BrowsePasClick(Sender: TObject);
var
s: string;
s: String;
begin
with SaveDialog1 do
begin
@ -119,7 +119,7 @@ begin
end;
procedure TMainForm.GenerateDfmFile(const filename, frmName: string;
procedure TMainForm.GenerateDfmFile(const filename, frmName: String;
wnd: HWND; PasList: TStrings);
var
OutStream: TFileStream;
@ -132,11 +132,11 @@ begin
b1.Free;
end;
procedure TMainForm.GeneratePasFile(const filename, frmname: string; PasList: TStrings);
procedure TMainForm.GeneratePasFile(const filename, frmname: String; PasList: TStrings);
var
title: string;
title: String;
fpas: TTextWriter;
i: integer;
i: Integer;
begin
fpas := TTextWriter.CreateFile(filename);
try
@ -177,7 +177,7 @@ end;
procedure TMainForm.SavePasClick(Sender: TObject);
var
dfmName: string;
dfmName: String;
wnd: HWND;
s: TStringList;
begin
@ -197,7 +197,7 @@ end;
procedure TMainForm.EnableSavePas;
var
UnitName: string;
UnitName: String;
begin
UnitName := ChangeFileExt(ExtractFileName(PasFileName.Text), '');
SavePas.Enabled := IsValidIdent(FormName.Text) and IsValidIdent(UnitName) and

28
frmResults.pas
View File

@ -38,7 +38,7 @@ uses StyleNames, WindowEnumerator;
function GetClassNameAsString(wnd: HWND): String;
var
class_name: array [0..100] of char;
class_name: array [0..100] of Char;
len: Integer;
begin
len := GetClassName(wnd, class_name, 100);
@ -60,11 +60,11 @@ procedure TResults.Savelistdata1Click(Sender: TObject);
var
f: TextFile;
n: TTreeNode;
i: integer;
i: Integer;
function RemoveTag(const s: string): string;
function RemoveTag(const s: String): String;
var
pos1: integer;
pos1: Integer;
begin
pos1 := Pos('=', s);
Result := Copy(s, pos1 + 2, Length(s) - pos1 - 1);
@ -108,7 +108,7 @@ end;
procedure TResults.GetWinInfoText(wnd: HWND; ParentNode: TTreeNode);
var
len: integer;
len: Integer;
Text: PChar;
begin
len := GetWindowTextLength(wnd) + 1;
@ -189,9 +189,9 @@ end;
procedure TResults.GetWinInfoListData(wnd: HWND; ParentNode: TTreeNode);
var
i, cbcount: integer;
i, cbcount: Integer;
node1, node2: TTreeNode;
itemtext: array [0..300] of char;
itemtext: array [0..300] of Char;
begin
with TreeView1.Items do
begin
@ -199,11 +199,11 @@ begin
cbcount := SendMessage(wnd, CB_GETCOUNT, 0, 0);
for i := 1 to cbcount do
begin
SendMessage(wnd, CB_GETLBTEXT, i - 1, longint(@itemtext));
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)));
AddChild(node2, 'Data = ' + IntToStr(SendMessage(wnd,
CB_GETITEMDATA, i - 1, 0)));
end;
end;
end;
@ -233,10 +233,12 @@ var
node2: TTreeNode;
begin
if not Assigned(ChildrenRootNode) then
ChildrenRootNode := Form.TreeView1.Items.AddChild(ParentNode, 'Children information');
ChildrenRootNode := Form.TreeView1.Items.AddChild(ParentNode,
'Children information');
Inc(ChildCount);
node2 := Form.TreeView1.Items.AddChild(ChildrenRootNode, 'Child #' + IntToStr(ChildCount));
Form.GetWinInfo(integer(wnd), node2);
node2 := Form.TreeView1.Items.AddChild(ChildrenRootNode, 'Child #' +
IntToStr(ChildCount));
Form.GetWinInfo(Integer(wnd), node2);
end;
procedure TResults.GetWinInfoChildren(wnd: HWND; ParentNode: TTreeNode);