Sometime Ago i wrote a patch to fix this behavior. the key is patch the code of the TCustomImageList.DoDraw
function, the technique used is similar to the used by the delphi-nice-toolbar
app, but instead of patch a bpl IDE in this case we patch the function in memory.
Just include this unit in your project
unit uCustomImageDrawHook;
interface
uses
Windows,
SysUtils,
Graphics,
ImgList,
CommCtrl,
Math;
implementation
type
TJumpOfs = Integer;
PPointer = ^Pointer;
PXRedirCode = ^TXRedirCode;
TXRedirCode = packed record
Jump: Byte;
Offset: TJumpOfs;
end;
PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
TAbsoluteIndirectJmp = packed record
OpCode: Word;
Addr: PPointer;
end;
TCustomImageListHack = class(TCustomImageList);
var
DoDrawBackup : TXRedirCode;
function GetActualAddr(Proc: Pointer): Pointer;
begin
if Proc <> nil then
begin
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
Result := PAbsoluteIndirectJmp(Proc).Addr^
else
Result := Proc;
end
else
Result := nil;
end;
procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
var
n: DWORD;
Code: TXRedirCode;
begin
Proc := GetActualAddr(Proc);
Assert(Proc <> nil);
if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
begin
Code.Jump := $E9;
Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
end;
end;
procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
var
n: Cardinal;
begin
if (BackupCode.Jump <> 0) and (Proc <> nil) then
begin
Proc := GetActualAddr(Proc);
Assert(Proc <> nil);
WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
BackupCode.Jump := 0;
end;
end;
procedure Bitmap2GrayScale(const BitMap: TBitmap);
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row : PRGBArray;
begin
BitMap.PixelFormat := pf24Bit;
for y := 0 to BitMap.Height - 1 do
begin
Row := BitMap.ScanLine[y];
for x := 0 to BitMap.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;
//from ImgList.GetRGBColor
function GetRGBColor(Value: TColor): DWORD;
begin
Result := ColorToRGB(Value);
case Result of
clNone:
Result := CLR_NONE;
clDefault:
Result := CLR_DEFAULT;
end;
end;
procedure New_Draw(Self: TObject; Index: Integer; Canvas: TCanvas; X, Y: Integer; Style: Cardinal; Enabled: Boolean);
var
MaskBitMap : TBitmap;
GrayBitMap : TBitmap;
begin
with TCustomImageListHack(Self) do
begin
if not HandleAllocated then Exit;
if Enabled then
ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0, GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
else
begin
GrayBitMap := TBitmap.Create;
MaskBitMap := TBitmap.Create;
try
GrayBitMap.SetSize(Width, Height);
MaskBitMap.SetSize(Width, Height);
GetImages(Index, GrayBitMap, MaskBitMap);
Bitmap2GrayScale(GrayBitMap);
BitBlt(Canvas.Handle, X, Y, Width, Height, MaskBitMap.Canvas.Handle, 0, 0, SRCERASE);
BitBlt(Canvas.Handle, X, Y, Width, Height, GrayBitMap.Canvas.Handle, 0, 0, SRCINVERT);
finally
GrayBitMap.Free;
MaskBitMap.Free;
end;
end;
end;
end;
procedure HookDraw;
begin
HookProc(@TCustomImageListHack.DoDraw, @New_Draw, DoDrawBackup);
end;
procedure UnHookDraw;
begin
UnhookProc(@TCustomImageListHack.DoDraw, DoDrawBackup);
end;
initialization
HookDraw;
finalization
UnHookDraw;
end.
and the result will be
I second Stefano on the fact that null=True, blank=True
is to be added. But, I think you only need to add it to the org_name
field of the Organization
model. That should make your way through. It has to be done because you have run inspectdb
to create models from your legacy DB. And probably the organization
table in the DB has an empty string stored. So, adding the above would allow the Admin to have a blank field/column displayed.
Moreover, you can also try using callbacks in situations where you don't want to make changes to your model definition like the above.
Best Answer
For a native look and feel, check the Windows Ribbon Framework for Delphi.
This is an Open Source wrapper around the Windows Ribbon Framework available since Windows 7 (and Vista after some official update is installed). This is the API used by the Windows 7 Word Pad.
Note also that you have two kind of layout: Office 2007 and Office 2010. The Delphi VCL Ribbon implements Office 2007 style, whereas the Windows Seven WordPad uses an Office 2010 style.
In some of our projects for some clients, we used TMS software Ribbon components. The code is a bit over-sized (a lot of duplicates or bad written stuff like component persistence) but it works and renders well, supporting both 2007 and 2010 Ribbon styles. For our Clients, rendering was what mattered. For our Open Source framework, we published a dual solution for building a Ribbon-like GUI, generated from code: it will use either standard VCL components for a basic layout, either the TMS components for a full Office 2007/2010 rendering. We just defined some classes, implemented by either libraries. If you use the generic components as defined in SQLite3ToolBar (i.e. the
TSynForm, TSynToolBar, TSynToolButton, TSynPopupMenu, TSynPage, TSynPager, TSynBodyPager
andTSynBodyPage
classes) and SynTaskDialog (forTSynButton
) in your own code, the USETMSPACK conditional will do all the magic for you.We didn't use yet the Ribbon component as was introduced in Delphi 2009. Its action-driven design won't make it easy to interface with the event-driven design of our User Interface handling, and we have to confess that this component has rather bad reputation (at least in the Delphi 2009 version).
The great Windows Ribbon Framework for Delphi won't fit our need of a on-the-fly generated Ribbon from code. Its design, from the Microsoft implementation itself, is to create the UI from an XML resource, linked at compilation... so it won't fit our needs, but it probably fit yours, for a more "static" application UI design.
If you use a Office-like Ribbon in your application, be aware of the Office UI Licensing.