استئصال وعلاج مرض وراثي

[Delphi4Us]

السلام عليكم ورحمة الله


ربما قراتم انني قلت في موضوع انني اخاطب امبركاديرو دائما لتحديث حزمة الـ VCL القديمة 
هذه الحزمة التي توارتثها الكثير من المكونات بنقصها وعيوبها مثل مكونات StyleControls و مكونات كثيرة أخرى

فأي مكون تجده يرث مثلا

كود :

type   TNewEdit = class(TEdit)

او

كود :

type   TNewDBGrid = class(TDBGrid)

فغالبا ستجده ورث كذلك العيوب ايضا ولم يعالجها ، بينما بعض المكونات عالجت المشكلة مثل مكونات Devexpress وايضا AlphaControl ومكونات اخرى
الان لدينا مشروع استئصال هذا المرض من هذه المكونات ولن نعتمد على امبركاديرو 
لدينا الكثير من العمليات الجراحية على العديد من المكونات ولكن سوف نبداء بمكون DBGrid وايضا Tedit وبعدها سوف نرى Tdate 


  NewStanderedVcl.rar (الحجم : 6.1 ك ب / التحميلات : 16)

وبداية عملت المشروع واضفت له بعض الخصائص مثلا في المكون Tedit اضفت الخاصية VerticalAlignment لمعالجة وضع النص بحال كان المكون ارتفاعه اكثر من المعدل الطبيعي ويحتاج الى البحث اكثر ولا تعمل حتى الان هذه الخاصية بالشكل المطلوب

وايضا اضفت للمكون  DBGrid الخاصية DefaultRowHeight وهي تعمل جيدا فقط تحتاج الى بعض التعديلات

والان كل من يمر من هنا فليعالج ما يمكن علاجه وبالمشاركة من الجميع سوف نحل مشكلة هذه الحزمة

---

عندما كتبت هذا المشروع حصل ظرف وخرجت من المنزل ورفعت المشروع حيث وصلت
ولهذا سوف تلاحظون ان ارتفاع الخلايا سوف يعود الى الارتفاع الافتراضي لهذا يجب التغيير الى هذا الكود للحفاظ على القيمة

كود :

unit DBGrid1; interface uses   System.SysUtils, System.Classes, Vcl.Controls, Vcl.Grids, Vcl.DBGrids; type TMyDBGrid = class(TDBGrid); type   TNewDBGrid = class(TDBGrid)   private     FDefaultRowHeight:Integer;   protected     procedure SetDefaultRowHeight(const Value: Integer);     procedure Paint; override;   public     constructor Create(AOwner: TComponent); override;   published     property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 21;   end; procedure Register; implementation procedure Register; begin   RegisterComponents('Samples', [TNewDBGrid]); end; { TNewDBGrid } constructor TNewDBGrid.Create(AOwner: TComponent); begin   inherited;   FDefaultRowHeight := 21;   TMyDBGrid(self).DefaultRowHeight := 21; end; procedure TNewDBGrid.Paint; begin   inherited;   if TMyDBGrid(self).DefaultRowHeight <> FDefaultRowHeight then   TMyDBGrid(self).DefaultRowHeight := FDefaultRowHeight; end; procedure TNewDBGrid.SetDefaultRowHeight(const Value: Integer); begin   if FDefaultRowHeight <> Value then begin     FDefaultRowHeight := Value;     TMyDBGrid(self).DefaultRowHeight := FDefaultRowHeight;   end; end; end.

[Delphi4Us]

كما قلت مكون Tedit وجعل الكتابة له VerticalAlignment مشكلة عالمية وحسب ما وجدت البعض يقول ان هذه الخاصية تدار بواسطة النظام نفسه ولا يوجد لها حل سهل الا بحلول جانبية وطويلة نوعا ما .
وجدت حل باستخدام دوال API واعادة رسم الكتابة ولكن ظهرت مشكلة عند استخدام Style المدمج مع دلفي حيث الخلفية للنص لا يتم تطبيق الستايل عليها
ساحاول ان احل المشكلة مثل ان اجد طريقة لجعل الخلفية شفافة وبالتالي تأخد لون Parent او الجاء الى برمجة اجراءات ترسم الاطار من جديد كما تفعل اغلب المكونات التي تعالج هذه المشكلة .
المكونات لا زالت تحتاج ايضا الى اضافة احداث جديدة مثل حدث تمرير عجلة الفأرة وغيرها من الاحداث المهمة
اذا كان هناك من يلم بالاحداث فليعمل عليها وليترك لي التعامل مع الخصائص

[Delphi4Us]

توقفت عن استخدام الكود لمعالجة المشكلة وسوف استخدم طريقة اخرى و ستكون ناجحة
ولمعرفة حجم المشكلة وتعقيدها يمكن معاينة وتجربة هذا الكود
فقط استبدل الكود للوحدة Tedit واعد ترجمة المشروع

كود :

unit NewEdit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,vcl.StdCtrls; // type // TVerticalAlignment = (taAlignTop, taAlignBottom, taVerticalCenter); type   TNewEdit = class(TEdit) private     FCanvas: TCanvas;     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;   protected     procedure WndProc(var Message: TMessage); override;     procedure Paint; virtual;     procedure PaintWindow(DC: HDC); override;     property Canvas: TCanvas read FCanvas;   public     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;   end; procedure Register; implementation procedure Register; begin   RegisterComponents('Samples', [TNewEdit]); end; { TNewEdit } constructor TNewEdit.Create(AOwner: TComponent); begin   inherited Create(AOwner);   FCanvas := TControlCanvas.Create;   TControlCanvas(FCanvas).Control := Self; end; destructor TNewEdit.Destroy; begin   FCanvas.Free;   inherited Destroy; end; procedure TNewEdit.Paint; var   R: TRect;   I: Integer;   S: String;   TextBounds: TRect; begin   R := ClientRect;   Inc(R.Left, 1);   Inc(R.Top, 1);   Canvas.Brush.Assign(Self.Brush);   Canvas.Font.Assign(Self.Font);   TextBounds := Rect(0, 0, ClientWidth, Font.Height);   R.Top := (R.Height div 2 - TextBounds.Height) div 2;   DrawText(Canvas.Handle, PChar(Text), -1, R, DT_LEFT or DT_VCENTER or ES_MULTILINE or       DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly); Inc(R.Left,Canvas.TextWidth(Text)); end; procedure TNewEdit.PaintWindow(DC: HDC); begin   //inherited;   FCanvas.Lock;   try     FCanvas.Handle := DC;     try       TControlCanvas(FCanvas).UpdateTextFlags;       Paint;     finally       FCanvas.Handle := 0;     end;   finally     FCanvas.Unlock;   end; end; procedure TNewEdit.WMPaint(var Message: TWMPaint); begin   ControlState := ControlState+[csCustomPaint];   inherited;   ControlState := ControlState-[csCustomPaint]; end; procedure TNewEdit.WndProc(var Message: TMessage); begin   inherited WndProc(Message);   with Message do     case Msg of       CM_MOUSEENTER, CM_MOUSELEAVE, WM_LBUTTONUP, WM_LBUTTONDOWN,       WM_KEYDOWN, WM_KEYUP,       WM_SETFOCUS, WM_KILLFOCUS,       CM_FONTCHANGED, CM_TEXTCHANGED:       begin         Invalidate;       end;   end; end; end.

[Ndagor]

القيت نظرة على الكود قمت بعض المحاولات ...
الكود التالي يعمل لاظهار النص في منتصف الخانات عموديا  و لكن يحتاج الى كثير من التنقيح لانه كما يقال الشيطان في التفاصيل
الكود يعمل و لكن لا ياخذ بعين الاعتبار نمط font لكل عمود اذا تم تحدده بشكل مستقل لكل عمود..
تعديل كود الدالة DrawCell

كود :

procedure TNewDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;   AState: TGridDrawState); var   H:integer; begin   H := (DefaultRowHeight - Abs(Canvas.Font.Height)) div 2;   Canvas.MoveTo(ARect.Left + 2, ARect.Top  + H -3);   SetTextAlign(Canvas.Handle, TA_UPDATECP);   inherited;   SetTextAlign(Canvas.Handle, TA_NOUPDATECP); end;

بالنسبة Edit 
يمكن استعمال EM_SETRECT للتحديد مساحة العمل المتاحة و هذا يتطلت انشاء المكون بخاصية 
mulitilines

كود :

TEdit2 = class(Vcl.StdCtrls.TEdit)   protected     procedure UpdateClientRect();     procedure CreateParams(var params:TCreateParams); override;     procedure CreateWnd(); override;     procedure WMSize(var Message: TWMSize); message WM_SIZE;   end; implementation { TEdit } procedure TEdit2.CreateParams(var params: TCreateParams); begin   inherited;   Params.Style := Params.Style                   or ES_MULTILINE; end; procedure TEdit2.CreateWnd; begin   inherited;   UpdateClientRect; end; procedure TEdit2.WMSize(var Message: TWMSize); begin   inherited;   UpdateClientRect(); end; procedure TEdit2.UpdateClientRect; var   R: TRect;   H, dlt:integer; begin   R := ClientRect;   H := Abs(Font.Height) * 120 div 100;   dlt := (R.Height - H) div 2;   R.Top := R.Top + dlt;   R.Height := H;   Perform(EM_SETRECT, 0, Longint(@R)); end;

---

يجب التنبيه انه الكود على النحو   Canvas.Font.Height احيانا لايعمل اذا لم تكن font فعليا مستعملة في Canvas

[Delphi4Us]

لم يعمل معي مكون Tedit وبما انه يعمل معك لم يعد هناك مجال للشك ان هناك مشكلة عندي
وبما انني لعبت بالوحدة الرئيسية Tedit للتجربة قبل انشاء مكون جديد قمت بتثبيت دلفي EX7 للتأكد وعملت معه بشكل جيد ، ولهذا لم تنجح كل المحاولات التي اجريتها وحملتها من الانترنت سابقا .
على العموم لقد حللت مشكلة كبيرة ولترى حجم المشكلة فقط ابحث بالقوقل عن

delphi tedit center text vertically

للاخذ بعين الاعتبار ملاحظتك حول   Canvas.Font.Height كتبت هذا الكود في حدث الانشاء

كود :

constructor TNewEdit.Create(AOwner: TComponent); begin   inherited Create(AOwner);   if FCanvas = nil then   begin    FCanvas := TControlCanvas.Create;    TControlCanvas(FCanvas).Control := Self;    FCanvas.Font := Font;   end; end;

ليتسنى استخدامه بحدث الرسم

كود :

procedure TNewEdit.UpdateClientRect; var   R: TRect;   H, dlt:integer; begin    R := ClientRect;    H := Abs(FCanvas.Font.Height) * 120 div 100;    dlt := (R.Height - H) div 2;    R.Top := R.Top + dlt;    R.Height := H;    Perform(EM_SETRECT, 0, Longint(@R)); end;

وطلما تم حل مشكلة هذه الوحدة من جذورها فكل المكونات الاخرى المصابة بالمرض سيتم شفائها لانها ترث هذا المكون ايضا ومنها
CompoBox و DBCompoBox وتقريبا المكون ListBox يواجه مشكلة في تحديد ارتفاع خلاياه

سوف اقوم باعادة تثبيت دلفي من جديد لترجع الوحدات الى اصلها لاني لا اعرف ما غيرت وما استبدلت وهي امور كثيرة للتجربة
وبعدها لنا عودة ان شاء الله

[Delphi4Us]

هناك مشكلة لم افهمها بعد
لقد قمت باعادة تثبيت دلفي 11.3 ولم تعمل برمجة الوحدة Tedit ولا تضع النص بالمنتصف
جربتها على دلفي 12 وايضا لم تعمل
وعملت فقط على دلفي EX7
فما نسخة الدلفي التي جربت انت بها

[kobayashi maru]

السلام عليكم و رحمة الله
استطيع ان اساعدكم في التجربة على نسخة دلفي 12 نظيفة دون الحاجة لاعادة تثبيت دلفي 12 او حذف الموكون الجديد و اعادة تثبيته في كل مرة....
- عندي بيئة افتراضية اعددتها خصيصا للعملية.

اقترح عليكم ما يلي:
فقط نحتاج بعض التنظيم:
- اضافة رقم اصدار جديد لكل نسخة معدلة للمكون موضوع التجربة.
- توحيد التسمية للحزمة D4A Components  و للمكون، مثل D4ADbgrid TD4ADbgrid
- اضافة معلومات عن ما تم تحسينه، تعديله و اضافته في اعلى (رأس) ملف سورس المكون.
- اضافة ديمو DEMO جاهزة للبناء.

اذا امكن اخ محمد فتح حساب GITHUB باسم المنتدى لنشر الاصدارات.

[Ndagor]

النسخة التي اعمل عليها دالفي 10.2 ..
يمكنك التحقق اولا بحذف السطر R.Height := H انحصل خطا في حساب ارتفاع فانه لا يعمل 
يمكنك التحقق ايضا ان كان دالفي الذي عندك يستخدم نفس مكون edit الخاص بالوندوز يمكن فعل ذلك يدويا بواسطة الكود التالي هو يقوم بازاحة الكتابة الى الاسفل ..ان عمل فهذا معناه ربما  الخطا فى حساب ارتفاع المكون ..

ملف المشروع

[Delphi4Us]

تتبعت الكود بوضع الـ Debug ويبدو كل شئ يعمل وهناك شئ لم اعرف ماهو
يعني تعمل على اصدارات واصدارات لا تعمل واحيانا تعمل ترجمة للمشروع فتعمل التغييرات واحيانا لا تعمل
المهم التعديل الاخير الذي ارفقته انت عمل وبالنسبة للمكون Tedit انتهينا منه

وسنحافظ على النسخة كـ Standered بدون اضافة رسم الصور او اشياء اخرى فقط الاساسيات وعلى الاقل حتى الان

توحيد التسمية للحزمة D4A Components  و للمكون، مثل D4ADbgrid TD4ADbgrid

من رأيي التسمية سهل تغييرها عن اكتمال المشروع ، اذا نجحت اعادة تحديث الحزمة يجب ان يتم ارسالها للشركة بالاسماء الافتراضية لتدمجها مع الدلفي وان كان بالامكان الاشارة الى موقع دلفي فيكون افضل 
واذا لم تفعل وقتها يمكننا نشرها بأسم المنتدى



الى اليسار المكونات المعدلة والى اليمين المكونات الاصلية

[kobayashi maru]

التجربة تمت على دلفي 12 و نظام التشغيل Windows 10

الحزمة تحتوي على وحدة UCrtlsFix غير موجودة و تمنع تثبيت المكونات...

PHP كود :

contains
  NewEdit in 'NewEdit.pas',
  NewDBGrid in 'NewDBGrid.pas',
  UCrtlsFix in 'UCrtlsFix.pas'; 


- مكون NewEdit يغمل بشكل جيد.
- مكون NewDBGrid ينقصه "Vertical Center" دقيق في حساب طول الفونت و لا يعمل نهائيا خلال تحرير قيمة ما...