I'm sharing some things that really don't have a cohesive topic and are so short I feel bad in posting them as individual FAQs.
They are little things that I've tried over the years or "proof of concepts" for certain things I have in more "production-oriented" code or even answers to questions previously asked here. There was a question, as well, of how much of this constitutes as "useful". It seemed the best idea from some advice I got from another person here was to just post it, make FAQ(s) out of what is interesting (to minimize what shows up in the FAQ section/reduce the admin's workload, etc), and see what happens.
Putting Notepad in a Panel
A bitmap as a form background
Compare two TBitmaps
Callback function Example - DLL
Callback function Example - Main Program, also shows dynamic DLL load
Sort CheckListBox based on what is checked (true first)
TColor explained in code.
Code changes a panel color based on the values of three scroll bars. Shows how TColor can be manipulated.
It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.
They are little things that I've tried over the years or "proof of concepts" for certain things I have in more "production-oriented" code or even answers to questions previously asked here. There was a question, as well, of how much of this constitutes as "useful". It seemed the best idea from some advice I got from another person here was to just post it, make FAQ(s) out of what is interesting (to minimize what shows up in the FAQ section/reduce the admin's workload, etc), and see what happens.
Putting Notepad in a Panel
Code:
var
procid: DWord;
procedure TForm1.Button1Click(Sender: TObject);
begin
Execute_Program('Notepad.exe', '', procid, false); // this is a function that I have that simply runs a program.
procid := Windows.FindWindow('Notepad', nil);
Windows.SetParent(procid, Panel1.Handle);
PostMessage(procid, WM_SYSCOMMAND, SC_MAXIMIZE, 0); // maximize the window.
end;A bitmap as a form background
Code:
var
mybitmap: TBitmap;
procedure TForm1.FormCreate(Sender: TObject);
begin
MyBitMap := TBitMap.Create;
MyBitMap.LoadFromFile('QUADRILL.BMP');
Form1.Brush.Bitmap := MyBitMap; // sets the bmp to be the background of the form.
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MyBitMap.Free;
end;Compare two TBitmaps
Code:
function GetPixelSize(informat: TPixelFormat): Extended;
// returns proper byte size for input
begin
case informat of
pf16bit: Result := 2;
pf24bit: Result := 3;
pf8bit: Result := 1;
pf1bit: Result := 1/8;
pf4bit: Result := 1/2;
pf32bit: Result := 4;
else
Result := 0;
end;
end;
function myBitmapsAreSame(Bitmap1, Bitmap2: TBitmap): Boolean;
var
i: integer;
RowSize: integer;
begin
Result := false;
if (Bitmap1.Width = Bitmap2.Width) and
(Bitmap1.Height = Bitmap2.Height) and
(Bitmap1.PixelFormat = Bitmap2.PixelFormat) then
begin
RowSize := trunc(Bitmap1.Width*GetPixelSize(Bitmap1.PixelFormat));
for i := (Bitmap1.Height-1) downto 0 do
begin
Result := CompareMem(Bitmap1.ScanLine[i], Bitmap2.ScanLine[i], RowSize);
if Result = false then exit;
end;
end;
end;Callback function Example - DLL
Code:
library mydll;
uses sysutils;
type
cbproc = function(num1, num2: integer): integer;
procedure domath(var invar: integer; mycallback: cbproc);
begin
invar := invar * 3;
invar := mycallback(invar, 2);
end;
exports
domath index 1;
end.Callback function Example - Main Program, also shows dynamic DLL load
Code:
{$APPTYPE CONSOLE}
program main; uses windows;
type
cbproc = function(num1, num2: integer): integer;
dmproc = procedure(var invar: integer; mycallback: cbproc);
var
libhandle: DWord;
dllproc: dmproc;
invar: integer;
function add_two_numbers(num1, num2: integer): integer;
begin
Result := Num1 + Num2;
end;
begin
write('Input invar: ');
readln(invar);
writeln;
writeln('DLL function multiplies by three.');
writeln('Callback function as called from DLL adds two.');
writeln;
libhandle := LoadLibrary('MYDLL.DLL');
if libhandle <> 0 then
begin
@DLLProc := GetProcAddress(libhandle, 'domath');
if @DLLProc <> nil then
dllproc(invar, @add_two_numbers);
FreeLibrary(libhandle);
end;
writeln('Invar is now: ', invar);
readln;
end.Sort CheckListBox based on what is checked (true first)
Code:
procedure TForm1.SortButtonClick(Sender: TObject);
var
i, j: integer;
begin
i := 0;
while (i < CheckListBox1.Items.Count-1) do
begin
if CheckListBox1.Checked[i] = true then
inc(i)
else
break;
end;
j := i;
while (j <= CheckListBox1.Items.Count-1) do
begin
if CheckListBox1.Checked[j] = true then
begin
CheckListBox1.Items.Exchange(j, i);
CheckListBox1.Checked[i] := true;
CheckListBox1.Checked[j] := false;
inc(i);
end;
inc(j);
end;
end;TColor explained in code.
Code changes a panel color based on the values of three scroll bars. Shows how TColor can be manipulated.
Code:
TForm1 = class(TForm)
Panel1: TPanel;
sbRed: TScrollBar;
sbGreen: TScrollBar;
sbBlue: TScrollBar;
...
end;
color_type = (ctRed, ctGreen, ctBlue);
procedure TForm1.FormShow(Sender: TObject);
begin
Label1.Caption := 'TColor = $' + IntToHex(Integer(Panel1.Color), 8);
end;
function SetColorChange(incolor: TColor; position: integer; color: color_type): TColor;
type
marray = array[0..3] of byte;
begin
Marray(incolor)[Integer(color)] := position;
Result := incolor;
end;
procedure TForm1.sbRedChange(Sender: TObject);
begin
Panel1.Color := SetColorChange(Panel1.Color, sbRed.Position, ctRed);
Label1.Caption := 'TColor = $' + IntToHex(Integer(Panel1.Color), 8);
end;
procedure TForm1.sbGreenChange(Sender: TObject);
begin
Panel1.Color := SetColorChange(Panel1.Color, sbGreen.Position, ctGreen);
Label1.Caption := 'TColor = $' + IntToHex(Integer(Panel1.Color), 8);
end;
procedure TForm1.sbBlueChange(Sender: TObject);
begin
Panel1.Color := SetColorChange(Panel1.Color, sbBlue.Position, ctBlue);
Label1.Caption := 'TColor = $' + IntToHex(Integer(Panel1.Color), 8);
end;It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.
