استئصال وعلاج مرض وراثي - نسخة قابلة للطباعة

استئصال وعلاج مرض وراثي - نسخة قابلة للطباعة

+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : مصادر دلفي مفتوحة تعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=14)
+--- الموضوع : استئصال وعلاج مرض وراثي (/showthread.php?tid=12450)

الصفحات: 1 2 3

استئصال وعلاج مرض وراثي - Delphi4Us - 16-11-2023

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

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

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

كود :
type
  TNewEdit = class(TEdit)

او

كود :
type
  TNewDBGrid = class(TDBGrid)

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

.rar

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.

RE: استئصال وعلاج مرض وراثي - Delphi4Us - 17-11-2023

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

RE: استئصال وعلاج مرض وراثي - Delphi4Us - 17-11-2023

توقفت عن استخدام الكود لمعالجة المشكلة وسوف استخدم طريقة اخرى و ستكون ناجحة
ولمعرفة حجم المشكلة وتعقيدها يمكن معاينة وتجربة هذا الكود
فقط استبدل الكود للوحدة 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.

RE: استئصال وعلاج مرض وراثي - Ndagor - 17-11-2023

القيت نظرة على الكود قمت بعض المحاولات ...
الكود التالي يعمل لاظهار النص في منتصف الخانات عموديا و لكن يحتاج الى كثير من التنقيح لانه كما يقال الشيطان في التفاصيل
الكود يعمل و لكن لا ياخذ بعين الاعتبار نمط 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

RE: استئصال وعلاج مرض وراثي - Delphi4Us - 17-11-2023

لم يعمل معي مكون 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 يواجه مشكلة في تحديد ارتفاع خلاياه

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

RE: استئصال وعلاج مرض وراثي - Delphi4Us - 18-11-2023

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

RE: استئصال وعلاج مرض وراثي - kobayashi maru - 18-11-2023

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

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

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

RE: استئصال وعلاج مرض وراثي - Ndagor - 18-11-2023

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

ملف المشروع

RE: استئصال وعلاج مرض وراثي - Delphi4Us - 18-11-2023

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

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

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

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

[صورة: GEwZaFr.jpg]

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

RE: استئصال وعلاج مرض وراثي - kobayashi maru - 18-11-2023

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

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

PHP كود :
contains
  NewEdit in 'NewEdit.pas',
  NewDBGrid in 'NewDBGrid.pas',
  UCrtlsFix in 'UCrtlsFix.pas'; 

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

[صورة: 6yEgamv.jpg]